Attribute VB_Name = "modVBoost"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'     VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   Files:
'     None
'   Conditional Compilation Values:
'     This is a heavily conditionally compiled file. The supported
'     project settings flags are shown here. VBOOST_CUSTOM turns off
'     all of the hooking, aggregation, and memory functions, which can
'     then be selectively turned back on. Calling a function that has been
'     conditionally removed will assert.
'
'     NOVBOOST = 1                 'No VBoost support, leaves only VarPtrArray definition
'      VBOOST_INTERNAL = 1         'Use the implementation of the VBoost objects in this file, not VBoost6.dll
'       VBOOST_CUSTOM              'All other flags except blind vtable sizes are ignored if this is not set
'        VBOOST_Aggregates         'Support AggregateUnknown and CreateAggregate
'         VBOOST_AggregateUnknown  'Support AggregateUnknown
'         VBOOST_CreateAggregate   'Support CreateAggregate
'        VBOOST_Hooks              'Support HookQI and HookQIAR functions
'         VBOOST_HookQI            'Support HookQI function
'         VBOOST_HookQIAR          'Support HookQIAR function
'       VBOOST_Memory              'Support CreateFixedSizeMemoryManager (both types)
'        VBOOST_Memory_Simple      'Support non-compactible memory manager
'        VBOOST_Memory_Compactible 'Support Compactible memory manager
'       VBOOST_BLIND               'Support CreateDelegator and BlindFunctionPointer
'     VBOOST_BLIND_1024            'Give the blind vtable its normal 1024 entries
'     VBOOST_BLIND_512             'Give the blind vtable 512 entries instead of 1024
'     VBOOST_BLIND_256             'Give the blind vtable 256 entries instead of 1024
'     VBOOST_BLIND_128             'Give the blind vtable 128 entries instead of 1024
'     VBOOST_BLIND_64              'Give the blind vtable 64 entries instead of 1024
'     VBOOST_BLIND_32              'Give the blind vtable 32 entries instead of 1024
'
' This file is used throughout the book. The VBoost reference is in Appendix A.
'***************************************************************
Option Explicit

#Const DO_AGG = (VBOOST_CUSTOM = 0) Or VBOOST_Aggregates Or VBOOST_AggregateUnknown Or VBOOST_CreateAggregate
#Const DO_AGGUNK = (VBOOST_CUSTOM = 0) Or VBOOST_Aggregates Or VBOOST_AggregateUnknown
#Const DO_AGGCREATE = (VBOOST_CUSTOM = 0) Or VBOOST_Aggregates Or VBOOST_CreateAggregate
#Const DO_HOOK = (VBOOST_CUSTOM = 0) Or DO_AGG Or VBOOST_Hooks Or VBOOST_HookQI Or VBOOST_HookQIAR
#Const DO_QIHOOK = (VBOOST_CUSTOM = 0) Or VBOOST_Hooks Or VBOOST_HookQI
#Const DO_QIARHOOK = (VBOOST_CUSTOM = 0) Or VBOOST_Hooks Or VBOOST_HookQIAR
#Const DO_FSMM = (VBOOST_CUSTOM = 0) Or DO_AGG Or VBOOST_BLIND Or VBOOST_Memory Or VBOOST_Memory_Simple
#Const DO_CFSMM = (VBOOST_CUSTOM = 0) Or VBOOST_Memory Or VBOOST_Memory_Compactible
#Const DO_BLIND = (VBOOST_CUSTOM = 0) Or VBOOST_BLIND Or DO_AGG
#Const DO_ARRAYOWNER = DO_HOOK Or DO_FSMM Or DO_CFSMM Or DO_AGG Or DO_BLIND
#Const DO_PROTECTERR = DO_HOOK Or DO_FSMM Or DO_CFSMM Or DO_AGG Or DO_BLIND
#Const DO_DUMMYFUNC = Not DO_AGGUNK Or Not DO_AGGCREATE Or Not DO_QIHOOK Or Not DO_QIARHOOK Or Not DO_FSMM Or Not DO_CFSMM Or Not DO_BLIND

'Add the one API we can't declare in the VBoostTypes
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long

#If NOVBOOST = 0 Then 'This file is reduced to a VarPtrArray declaration if NOVBOOST is set
'The publicly accessible VBoost object
Public VBoost As VBoostRoot

#If VBOOST_INTERNAL = 0 Then
Public Sub InitVBoost()
    'If you get an error here, then you either have
    'to add a reference to VBoost6.Dll (VBoost Object Implementation (6.0)),
    'or set VBOOST_INTERNAL to 1.
    If VBoost Is Nothing Then Set VBoost = New VBoostRootImpl
End Sub
#Else
#If DO_BLIND Then
    #If VBOOST_BLIND_512 Then
        Private Const cBlindVTableEntries As Long = 512
    #ElseIf VBOOST_BLIND_256 Then
        Private Const cBlindVTableEntries As Long = 256
    #ElseIf VBOOST_BLIND_128 Then
        Private Const cBlindVTableEntries As Long = 128
    #ElseIf VBOOST_BLIND_64 Then
        Private Const cBlindVTableEntries As Long = 64
    #ElseIf VBOOST_BLIND_32 Then
        Private Const cBlindVTableEntries As Long = 32
    #Else
        'To further customize, change this value to whatever is appropriate for your project.
        '1024 is the highest value that is generally expected by a COM vtable.
        Private Const cBlindVTableEntries As Long = 1024
    #End If
#End If

'IID declarations
Private IID_IUnknown As IID
Private Const Data1_IID_IUnknown As Long = 0
Private IID_VBoostRoot As IID
Private Const Data1_IID_VBoostRoot As Long = &H20708EE1

#If DO_HOOK Then
    Private IID_IProvideClassInfo As IID
    Private Const Data1_IID_IProvideClassInfo As Long = &HB196B283
    Private IID_UnknownHook As IID
    Private Const Data1_IID_UnknownHook As Long = &H20708EE3
#End If

'Root object types and structures. The root object is
'a singleton, so we don't have to worry about refcounting.
'The only worry is that a caller may take down VBoost
'before we're in teardown code. For this reason, this
'module uses PrivVBoost instead of VBoost. There is also
'a SafeVBoost function which is used to provide VBoost for
'code that is likely to fire during a normal teardown process.
Private Type RootStruct
    pVTable As Long
    VTable(21) As Long
    ASM(46) As Long
#If DO_PROTECTERR Then
    pProtectErr As IUnknown
    VTableProtectErr(2) As Long
    pVTableProtectErr As Long
#End If
End Type
Private m_Root As RootStruct
Private PrivVBoost As VBoostRoot

#If DO_ARRAYOWNER Then
    'ArrayOwner copy to remove all external file dependencies.
    'This is a special version of ArrayOwner that enables VBoost.Bas
    'to be placed anywhere in the module teardown order. VB tears down
    'the ArrayOwner items during module teardown because it sees an
    'object and an array. If another standard module has a reference to
    'a VBoost object, such as a FixedSizeMemoryManager, then this takes
    'down our m_Deref variables while we still need them. The workaround
    'is to temporarily fake VB by adding another object after the array
    'when the object before the array is hit. This allows the array to be
    'zeroed then restored again so that it can continue to be used. VB doesn't
    'revisit the structure after it cleans it, so it will never try to free
    'the array. This cat-and-mouse game isn't pretty, but it is very effective.
    Private Type ArrayOwnerVTable
        VTable(5) As Long
    End Type
    Private m_ArrayOwnerVTable As ArrayOwnerVTable
    Private m_pArrayOwnerVTable As Long
        
    Private Type ArrayOwner
        pVTable As Long
        pThisObject As IUnknown
        SA As SafeArray1d
        'pSA() As SafeArray assumed
        'pThisObject2 As IUnknown assumed
    End Type
    'A secondary version used during teardown
    Private Type ArrayOwnerTeardown
        pVTable As Long
        pThisObject As Long
        SA As SafeArray1d
        pSA As Long
        pThisObject2 As Long
    End Type
#End If

#If DO_BLIND Then
    'Blind delegator types and structures
    Private Type BlindCodeEntry
        Bytes(5)  As Byte
        Shorts(1) As Integer
    End Type
    Private Type BlindCode
        VTable(cBlindVTableEntries - 1) As Long
        ThunkAndQICode(7) As Long
        Entries(3 To cBlindVTableEntries - 1) As BlindCodeEntry
    End Type
    
    'Helper structs for LSet while generating blind code
    Private Type OneInt
        I1 As Integer
    End Type
    Private Type TwoBytes
        B1 As Byte
        B2 As Byte
    End Type
    Private m_BlindCode As BlindCode
    Private m_pBlindVTable As Long
    
    'Help for creating new delegators
    Private Type OwnedBlindDelegator
        Owner As ArrayOwner
        pSA() As BlindDelegator
        pThisObject2 As IUnknown
    End Type
    Private m_DerefBlindDelegator As OwnedBlindDelegator
    
    'Copy of FunctionDelegator structure to remove dependency
    Private Type FunctionDelegator
        pVTable As Long  'This has to stay at offset 0
        pfn As Long      'This has to stay at offset 4
    End Type
    Private Type FunctionDelegatorVTable
        VTable(3) As Long
    End Type
    Private m_FunctionDelegatorVTable As FunctionDelegatorVTable
    Private m_FunctionDelegatorASM As Currency
    Private m_pFunctionDelegatorVTable As Long
#End If 'DO_BLIND

#If DO_FSMM Or DO_CFSMM Then
    Private Type FSMMBase
        pVTable As Long
        cRefs As Long
        ElemSize As Long
        ElemsPerBlock As Long
        pFirstBlock As Long
    End Type
    Private Type OwnedLong
        Owner As ArrayOwner
        pSA() As Long
        pThisObject2 As IUnknown
    End Type
    Private m_DerefLong As OwnedLong
#End If 'DO_FSMM Or DO_CFSMM

#If DO_FSMM Or DO_CFSMM Then
    Private IID_FixedSizeMemoryManager As IID
    Private Const Data1_IID_FixedSizeMemoryManager As Long = &H20708EE7
#End If
#If DO_FSMM Then
    
    'Fixed-size memory types and structures
    'FixedSizeMemoryManager class data
    Private Type FSMMVTable
        VTable(6) As Long
    End Type
    Private m_FSMMVTable As FSMMVTable
    Private m_pFSMMVTable As Long
    
    Private Type FixedMemMgr
        Base As FSMMBase
        pFree As Long
        cFreshItems As Long
        pFreshItem As Long
    End Type
#End If 'DO_FSMM


#If DO_CFSMM Then
    Private IID_CompactibleFixedSizeMemoryManager As IID
    Private Const Data1_IID_CompactibleFixedSizeMemoryManager As Long = &H20708EE8
    
    'CompactibleFixedSizeMemoryManager class data
    Private Const cCFSMMIIDs As Long = 3
    Private Type CFSMMVTable
        VTable(11) As Long
    End Type
    Private m_CFSMMVTable As CFSMMVTable
    Private m_pCFSMMVTable As Long
    
    Private Type CompactibleFixedMemMgr
        Base As FSMMBase
        BlockSize As Long
        cEmptyBlocks As Integer
        cBufferBlocks As Integer
        fCompactOnFree As Boolean
    End Type
    
    Private Type CFSMMBlock
        pNext As Long 'pNext must stay first for easy relinking
        pFree As Long
        cInUse As Long
        fFreeIsList As Boolean
    End Type
    Private Const cCFSMMBlockBufferOffset As Long = 16 '4-byte aligned size of CFSMMBlock
    
    Private Type OwnedCFSMMBlock
        Owner As ArrayOwner
        pSA() As CFSMMBlock
        pThisObject2 As IUnknown
    End Type
    Private m_DerefCFSMMBlock As OwnedCFSMMBlock
#End If 'DO_CFSMM

#If DO_HOOK Then
    'Types and structures for IUnknown hooking functions
    Private Const hfHookQIBefore As Long = 1  'Keep at 1 to match uhBeforeQI
    Private Const hfHookQIAfter As Long = 2   'Keep at 2 to match uhAfterQI
    Private Const hfMapIIDs As Long = 4       'Keep at 4 to match uhMapIIDs
    Private Const hfReportAddRef As Long = 8       'Keep at 8 to match uhAddRef
    Private Const hfReportRelease As Long = &H10   'Keep at 16 to match uhRelease
    Private Const hfWeakQIHook As Long = &H20
    Private Const hfWeakQIHookExplicit As Long = &H40
    Private Const hfARHook As Long = &H80
    
    Private Type QIARHookStructVTable
        VTable(3) As Long
    End Type
    Private Type QIARHookStruct
        VTable As QIARHookStructVTable
        pOuter As VBoostTypes.IProvideClassInfo
        pQIARHook As IQIARHook
        pVTableStart As Long
        pOwner As VBoostTypes.IUnknownUnrestricted
        Flags As Long
    End Type
    
    Private Type OwnedQIARHookStruct
        Owner As ArrayOwner
        pSA() As QIARHookStruct
        pThisObject2 As IUnknown
    End Type
    Private m_DerefQIARHook As OwnedQIARHookStruct
    Private m_QIHookStructVTable As QIARHookStructVTable
    #If DO_QIARHOOK Then
        Private m_QIARHookStructVTable As QIARHookStructVTable
    #End If
#End If 'DO_HOOK

#If DO_QIHOOK Or DO_QIARHOOK Then
    Private Type UnknownHookStruct
        pVTable As Long
        cRefs As Long
        Hook As QIARHookStruct
    End Type
    
    Private Type UnknownHookVTable
        VTable(4) As Long
    End Type
    Private m_UnknownHookVTable As UnknownHookVTable
    Private m_pUnknownHookVTable As Long
    
    Private Type OwnedUnknownHookStruct
        Owner As ArrayOwner
        pSA() As UnknownHookStruct
        pThisObject2 As IUnknown
    End Type
    Private m_DerefUnknownHook As OwnedUnknownHookStruct
#End If

#If DO_AGG Then
    Private IID_IDispatch As IID

    'Types and structures for aggregation objects
    'A structure to figure out element counts before the
    'memory for CAggregator (and its derived classes) is
    'actually pulled off the heap.  This lets us allocate
    'all required elements in a single shot.
    Private Type PreAllocData
        pExtraBytes As PVOID     ' The starting offset of the extra data
        cExtraBytes As Long      ' Filled in by constructor
        cIIDs As Long            ' Total IID count
        cUnfiltered As Long      ' The number of unfiltered items (should be total - cMaps)
        cUnfilteredNoDelegator As Long ' The number of unfiltered items that have NoDelegator set
        cUnfilteredBefore As Long  ' The number of unfiltered objects with a before flag
        cIIDMapAndBlockElems As Long ' The number of items that turn into an IID map or a block
        cIIDMaps As Long           ' The total number of mapped IIDs, one per map
        cIIDBlocks As Long        ' The total number of blocked IIDs, >=1 per map
        fHaveDispHook As Boolean  ' Whether or not we've seen the primary dispatch flag
    End Type
    
    'A node to hold the IID information, as well as the location
    'of the blind delegator structure.  This lets us do multiple things:
    '1)(Most importantly) The blind delegators must be able to outlive
    '  the aggregator because the aggregator can be released before all
    '  interfaces retrieved through it have been destroyed.  The aggregator
    '  needs to know when an interface is already outstanding, so there must
    '  be some means of communication from the delegator back into the aggregator
    '  when an interface is no longer in use.  Because the aggregator may be
    '  gone when the notification happens, the only way to do this is to essentially
    '  have joint control over the memory.  When the aggregator dies, it
    '  walks all outstanding interfaces (those with Del.m_dwRefs > 0),
    '  AddRefs the memory allocator, and swaps in a different destruction function.
    '2)This gives us a means of maintaining the ObjPtr for all interfaces retrieved
    '  from the aggregator.  Even if the interface is fully released, it is nice
    '  if a subsequent QI for the same interface retrieves the same object.
    '3)We can search the list for punkInner values to determine the external pointer
    '  to the given interface from inside the object, similar to SafeRef in MTS land.
    '4)For an unfiltered object, when we find the IID, we permanently attach the
    '  node to the end  of the filtered list of IIDs when a QI succeeds.  This
    '  cache enables us to jump directly to the correct object on a subsequent
    '  QI for the same IID.
    Private Type IIDHookNode
        BlindDel As BlindDelegator 'Blind delegator to attach to this IID
        IID As IID                 'IID to hook
        pNext As Long              'IIDHookNode* Next node in the chain
        pFSMMOwner As FixedSizeMemoryManager  'Reference to owning node
        iUnk As Long               'Index of object in pHoldUnks array
    End Type
    Private Type IIDHookNodeList
        pHead As Long  'IIDHookNode*
        ppTail As Long 'IIDHookNode**
    End Type
    
    'A structure to hold IID mapping information.  These are
    'preallocated with the CAggregator object.
    'Note that we treat this as two IIDs for simplicity in
    'derefing the pointers with the same SafeArray we use
    'for a straight IID array.
    'Private Type IIDMapEntry
    '    IIDFrom As IID
    '    IIDTo As IID
    'End Type
    
    Private Enum CHoldUnkFlags
        'Don't generate a blind delegator around this item
        fNoDelegator = 1
        'This is held as a weak ref, which means that a ref
        'has been released on the controlling IUnknown.  This
        'ref must be replaced before the final release.
        fWeakRef = 2
        'm_pUnk is a reference to an IDelayCreation interface,
        'not the real object we return
        fDelayedCreation = 4
        'We should keep this as a delayed creator instead of cache
        'the returned interface pointer
        fKeepDelayed = 8
        'The stored pointer is fully resolved to the correct IID and
        'shouldn't be QI'ed.  Just AddRef and return it.  This is
        'done for overriding the primary dispatch, where a QI would
        'actually return the wrong interface.
        fFullyResolved = &H10
        'The WeakRef quality of this object was explicitly set in the
        'AggregateData structure. Used only in the delayed creation case.
        fWeakRefExplicit = &H20
        'The stored pointer is a raw weak reference. It is not balanced
        'by a Release on the controlling IUnknown.
        fWeakRefRaw = &H40
    End Enum
    Private Type CHoldUnk
        pUnk As VBoostTypes.IUnknownUnrestricted
        Flags As CHoldUnkFlags
    End Type
    
    Private Const ciBeforeNodes As Long = 0
    Private Const ciAfterNodes As Long = 1
    Private Type CAggregator
        pFSMMNodes As FixedSizeMemoryManager 'The memory manager for all nodes
        NodesList(ciBeforeNodes To ciAfterNodes) As IIDHookNodeList 'Node list for the before and after QI hooks
        cIIDMaps As Long                     'A count of items in pIIDMaps
        pIIDMaps As Long 'IIDMapEntry*       'A list of mappings.  Don't delete these, they're preallocated with the object.
        cBlockIIDs As Long                   'A count of items in the pBlockIIDs mapping.
        pBlockIIDs As Long 'IID*             'A list of IIDs to block.  Don't delete these, they're preallocated with the object.
        cHoldUnks As Long                    'A count of items in the pHoldUnks array
        pHoldUnks As Long 'CHoldUnk*         'Array of unknown objects.  The unfiltered are stored first, then all the rest.
        cUnfilteredBefore As Integer         'The total count of unfiltered items in the pHoldUnks array for a BeforeQI
        cUnfilteredAfter As Integer          'The total count of unfiltered items in the pHoldUnks array for an AfterQI
    End Type
    
    Private Type OwnedCHoldUnk
        Owner As ArrayOwner
        pSA() As CHoldUnk
        pThisObject2 As IUnknown
    End Type
    Private m_DerefCHoldUnk As OwnedCHoldUnk
    
    Private Type OwnedIIDHookNode
        Owner As ArrayOwner
        pSA() As IIDHookNode
        pThisObject2 As IUnknown
    End Type
    Private m_DerefIIDHookNode As OwnedIIDHookNode
    
    Private m_fAggregatorsInit As Boolean
#End If 'DO_AGG

#If DO_BLIND Or DO_AGG Then
    'Array derefing structure
    Private Type OwnedIIDArray
        Owner As ArrayOwner
        pSA() As IID
        pThisObject2 As IUnknown
    End Type
    Private m_DerefIIDs As OwnedIIDArray
#End If

#If DO_AGGCREATE Then
    Private Type AggregateObjectVTable
        VTable(2) As Long
    End Type
    Private m_AggregateObjectVTable As AggregateObjectVTable
    Private m_pAggregateObjectVTable As Long
    
    Private Type CAggregateObject
        pVTable As Long
        cRefs As Long
        Aggregator As CAggregator
        uhFlags As UnkHookFlags 'Cache flags, GetFlags isn't free
        ppThis As Long
    End Type
    
    'Array derefing structure
    Private Type OwnedAggregateObject
        Owner As ArrayOwner
        pSA() As CAggregateObject
        pThisObject2 As IUnknown
    End Type
    Private m_DerefAggregateObject As OwnedAggregateObject
#End If 'DO_AGGCREATE

#If DO_AGGUNK Then
    Private Type CUnkHookAggregate
        pVTable As Long
        pQIHookVTable As Long
        cRefs As Long
        Hook As QIARHookStruct
        Aggregator As CAggregator
    End Type
    Private Type CUnkHookAggregateIQIHook
        pQIHookVTable As Long
        cRefs As Long
        Hook As QIARHookStruct
        Aggregator As CAggregator
    End Type

    Private Type UnkHookAggregateVTables
        VTable(4) As Long
        IQIHookVTable(4) As Long
    End Type
    Private m_UnkHookAggregateVTables As UnkHookAggregateVTables
    Private m_pUnkHookAggregateVTable As Long
    Private m_pUnkHookAggregateIQIHookVTable As Long
    
    'Array derefing structure
    Private Type OwnedUnkHookAggregate
        Owner As ArrayOwner
        pSA() As CUnkHookAggregate
        pThisObject2 As IUnknown
    End Type
    Private m_DerefUnkHookAggregate As OwnedUnkHookAggregate
#End If 'DO_AGGUNK

Public Sub InitVBoost()
#If DO_DUMMYFUNC Then
Dim pfnDummy As Long
#End If
    With m_Root
        If .pVTable = 0 Then
            'Unitialized, layout our vtable, asm entries, and IIDs
            IID_IUnknown = IIDFromString(strIID_IUnknown)
            IID_VBoostRoot = IIDFromString(strIID_VBoostRoot)
            #If DO_HOOK Then
                IID_IProvideClassInfo = IIDFromString(strIID_IProvideClassInfo)
                IID_UnknownHook = IIDFromString(strIID_UnknownHook)
            #End If
            #If DO_FSMM Or DO_CFSMM Then
                IID_FixedSizeMemoryManager = IIDFromString(strIID_FixedSizeMemoryManager)
            #End If
            #If DO_CFSMM Then
                IID_CompactibleFixedSizeMemoryManager = IIDFromString(strIID_CompactibleFixedSizeMemoryManager)
            #End If
            #If DO_AGG Then
                IID_IDispatch = IIDFromString(strIID_IDispatch)
            #End If
            #If DO_DUMMYFUNC Then
                pfnDummy = FuncAddr(AddressOf ErrorDummy)
            #End If
        
            'Assign
            .ASM(0) = &HC24448B
            .ASM(1) = &H824548B
            .ASM(2) = &HA89088B
            .ASM(3) = &H90000CC2
            'Deref
            .ASM(4) = &H824448B
            .ASM(5) = &H8C2008B
            .ASM(6) = &H90909000
            'UAdd
            .ASM(7) = &HC24448B
            .ASM(8) = &H8244C8B
            .ASM(9) = &HCC2C103
            .ASM(10) = &H90909000
            'UDif
            .ASM(11) = &H824448B
            .ASM(12) = &HC244C8B
            .ASM(13) = &HCC2C12B
            .ASM(14) = &H90909000
            'UGT
            .ASM(15) = &HC24448B
            .ASM(16) = &H8244C8B
            .ASM(17) = &HC01BC13B
            .ASM(18) = &H90000CC2
            'UGTE
            .ASM(19) = &H824448B
            .ASM(20) = &HC244C8B
            .ASM(21) = &HC01BC13B
            .ASM(22) = &HC248D8F7
            .ASM(23) = &H9090000C
            'AssignZero
            .ASM(24) = &H8244C8B
            .ASM(25) = &H189C033
            .ASM(26) = &H900008C2
            'AssignSwap
            .ASM(27) = &H824448B
            .ASM(28) = &HC24548B
            .ASM(29) = &HA87088B
            .ASM(30) = &HCC20889
            .ASM(31) = &H90909000
            'MoveVariant
            .ASM(32) = &HC24448B
            .ASM(33) = &H824548B
            .ASM(34) = &H8B56C88B
            .ASM(35) = &H8B328931
            .ASM(36) = &H72890471
            .ASM(37) = &H8718B04
            .ASM(38) = &H5E087289
            .ASM(39) = &H890C498B
            .ASM(40) = &HC7660C4A
            .ASM(41) = &HC2000000
            .ASM(42) = &H9090000C
            'UDiv
            .ASM(43) = &H824448B
            .ASM(44) = &H74F7D233
            .ASM(45) = &HCC20C24
            .ASM(46) = &H90909000
            
            .VTable(0) = FuncAddr(AddressOf Root_QueryInterface)
            .VTable(1) = FuncAddr(AddressOf AddRefRelease)
            .VTable(2) = .VTable(1)
            #If DO_QIHOOK Then
                .VTable(3) = FuncAddr(AddressOf HookQI)
            #Else
                .VTable(3) = pfnDummy
            #End If
            #If DO_QIARHOOK Then
                .VTable(4) = FuncAddr(AddressOf HookQIAR)
            #Else
                .VTable(4) = pfnDummy
            #End If
            .VTable(5) = FuncAddr(AddressOf SafeUnknown)
            #If DO_BLIND Then
                .VTable(6) = FuncAddr(AddressOf CreateDelegator)
            #Else
                .VTable(6) = pfnDummy
            #End If
            #If DO_AGGUNK Then
                .VTable(7) = FuncAddr(AddressOf AggregateUnknown)
            #Else
                .VTable(7) = pfnDummy
            #End If
            #If DO_AGGCREATE Then
                .VTable(8) = FuncAddr(AddressOf CreateAggregate)
            #Else
                .VTable(8) = pfnDummy
            #End If
            .VTable(9) = FuncAddr(AddressOf AssignAddRef)
            #If DO_BLIND Then
                .VTable(10) = FuncAddr(AddressOf BlindFunctionPointer)
            #Else
                .VTable(10) = pfnDummy
            #End If
            #If DO_FSMM Or DO_CFSMM Then
                .VTable(11) = FuncAddr(AddressOf CreateFixedSizeMemoryManager)
            #Else
                .VTable(11) = pfnDummy
            #End If
            .VTable(12) = VarPtr(.ASM(0)) 'Assign
            .VTable(13) = VarPtr(.ASM(4)) 'Deref
            .VTable(14) = VarPtr(.ASM(7)) 'UAdd
            .VTable(15) = VarPtr(.ASM(11)) 'UDif
            .VTable(16) = VarPtr(.ASM(15)) 'UGT
            .VTable(17) = VarPtr(.ASM(19)) 'UGTE
            .VTable(18) = VarPtr(.ASM(24)) 'AssignZero
            .VTable(19) = VarPtr(.ASM(27)) 'AssignSwap
            .VTable(20) = VarPtr(.ASM(32)) 'MoveVariant
            .VTable(21) = VarPtr(.ASM(43)) 'UDiv
            .pVTable = VarPtr(.VTable(0))
            
            #If DO_PROTECTERR Then
                .VTableProtectErr(0) = FuncAddr(AddressOf SayNo_QueryInterface)
                .VTableProtectErr(1) = FuncAddr(AddressOf AddRefRelease)
                .VTableProtectErr(2) = FuncAddr(AddressOf ProtectErr_Release)
                .pVTableProtectErr = VarPtr(.VTableProtectErr(0))
                CopyMemory .pProtectErr, VarPtr(.pVTableProtectErr), 4
            #End If
            CopyMemory PrivVBoost, VarPtr(.pVTable), 4
        End If
        Set VBoost = PrivVBoost
    End With
End Sub

#If DO_DUMMYFUNC Then
Private Function ErrorDummy(ByVal This As Long) As Long
    Debug.Assert False 'This function is not implemented with the current VBOOST conditionals
    ErrorDummy = E_NOTIMPL
End Function
#End If
#If DO_ARRAYOWNER Then
'ArrayOwner code
Private Sub InitArrayOwner(ArrayOwner As ArrayOwner, ByVal cbElements As Long)
Dim pSA As Long
Dim fOldFeatures As Integer
    If m_pArrayOwnerVTable = 0 Then
        With m_ArrayOwnerVTable
            .VTable(0) = FuncAddr(AddressOf SayNo_QueryInterface)
            .VTable(1) = FuncAddr(AddressOf AddRefRelease)
            .VTable(2) = FuncAddr(AddressOf ArrayOwner_ReleasePreArray)
            .VTable(3) = .VTable(0)
            .VTable(4) = .VTable(1)
            .VTable(5) = FuncAddr(AddressOf ArrayOwner_ReleasePostArray)
            m_pArrayOwnerVTable = VarPtr(.VTable(0))
        End With
    End If
    With ArrayOwner.SA
        If .cDims = 0 Then
            .cDims = 1
            .cElements = 1
            .cLocks = 1
            .cbElements = cbElements
            With ArrayOwner
                .pVTable = m_pArrayOwnerVTable
                PrivVBoost.Assign .pThisObject, VarPtr(.pVTable)
                PrivVBoost.Assign ByVal PrivVBoost.UAdd(VarPtr(ArrayOwner), LenB(ArrayOwner)), VarPtr(.SA)
            End With
        End If
    End With
End Sub
Private Function ArrayOwner_ReleasePreArray(This As ArrayOwnerTeardown) As Long
    'See comments at ArrayOwner definition in this file
    With This
        .pSA = 0
        .pVTable = VarPtr(m_ArrayOwnerVTable.VTable(3))
        .pThisObject2 = VarPtr(.pVTable)
    End With
End Function
Private Function ArrayOwner_ReleasePostArray(This As ArrayOwnerTeardown) As Long
    'See comments at ArrayOwner definition in this file
    With This
        .pSA = VarPtr(.SA)
        'There is no need to reprotect the array at this point in the teardown
        'process. VB is way too far along in its teardown process to ever
        'visit pSA again. The array can be reprotected with the following code.
        '.pVTable = m_pArrayOwnerVTable
        '.pThisObject = VarPtr(.pVTable)
    End With
End Function
#End If 'DO_ARRAYOWNER

'Call this function from code in this module that could run
'during final teardown after the VBoost variable has been released.
Private Function SafeVBoost() As VBoostRoot
    If PrivVBoost Is Nothing Then
        CopyMemory SafeVBoost, VarPtr(m_Root.pVTable), 4
    Else
        PrivVBoost.Assign SafeVBoost, PrivVBoost
    End If
End Function
Private Function MapError() As Long
Dim Number As Long
    Number = Err.Number
    If Number Then
        If Number > 0 Then Number = &H800A0000 Or Number
        MapError = Number
    End If
End Function
Private Function Root_QueryInterface(ByVal This As Long, riid As VBoostTypes.VBGUID, pvObj As Long) As Long
    pvObj = 0
    Select Case riid.Data1
        Case Data1_IID_VBoostRoot
            If IsEqualIID(riid, IID_VBoostRoot) Then pvObj = This
        Case Data1_IID_IUnknown
            If IsEqualIID(riid, IID_IUnknown) Then pvObj = This
    End Select
    If pvObj = 0 Then Root_QueryInterface = E_NOINTERFACE 'Singleton, don't bother with AddRef
End Function
Private Function AddRefRelease(ByVal This As Long) As Long
    'Nothing to do
End Function

#If DO_PROTECTERR Then
Private Function ProtectErr_Release(ByVal This As Long) As Long
    On Error Resume Next
    Err.Raise 5
    On Error GoTo 0
End Function
#End If

#If DO_BLIND Or DO_ARRAYOWNER Or DO_PROTECTERR Then
Private Function SayNo_QueryInterface(ByVal This As Long, riid As Long, pvObj As Long) As Long
    pvObj = 0
    SayNo_QueryInterface = E_NOINTERFACE
End Function
#End If 'DO_BLIND Or DO_ARRAYOWNER
Private Function SafeUnknown(This As RootStruct, ByVal pUnknown As stdole.IUnknown, retVal As stdole.IUnknown) As Long
    'The ByVal on pUnknown means that VB AddRef's it on the
    'way in, so all we have to do is transfer the value to
    'retVal and zero pUnknown. Don't use AssignSwap because
    'retVal may have garbage in it.
    PrivVBoost.Assign retVal, pUnknown
    PrivVBoost.AssignZero pUnknown
End Function
Private Sub AssignAddRef(This As RootStruct, pDst As stdole.IUnknown, pSrc As stdole.IUnknown)
    PrivVBoost.AssignZero pDst
    Set pDst = pSrc
End Sub

#If DO_BLIND Then
Private Function BlindFunctionPointer(This As RootStruct, ByVal FunctionNumber As Long, retVal As Long) As Long
    On Error GoTo Error
    If FunctionNumber = -1 Then 'Request for the whole vtable
        If m_pBlindVTable = 0 Then Blind_InitCode
        retVal = m_pBlindVTable
    Else
        If FunctionNumber < 0 Or FunctionNumber > (cBlindVTableEntries - 1) Then Err.Raise 9
        If m_pBlindVTable = 0 Then Blind_InitCode
        retVal = m_BlindCode.VTable(FunctionNumber)
    End If
    Exit Function
Error:
    BlindFunctionPointer = MapError
End Function
Private Function CreateDelegator(This As RootStruct, ByVal punkOuter As stdole.IUnknown, ByVal punkDelegatee As stdole.IUnknown, ByVal pIID As VBGUIDPtr, ByVal pEmbedded As BlindDelegatorPtr, ByVal pfnDestroyEmbedded As Long, ThisPtr As Long) As Long
    ThisPtr = 0
    On Error GoTo Error
    If m_pBlindVTable = 0 Then Blind_InitCode
    If m_DerefBlindDelegator.Owner.SA.cDims = 0 Then
        'Do these here because they aren't needed by BlindFunctionPointer,
        'which is under the same compilation switch.
        With m_DerefIIDs
            'Also set in InitAggregators, may be initialized already
            If .Owner.SA.cDims = 0 Then InitArrayOwner .Owner, LenB(.pSA(0))
        End With
        With m_DerefBlindDelegator
            InitArrayOwner .Owner, LenB(.pSA(0))
        End With
    End If
    If pIID Then Blind_ResolveInner punkDelegatee, pIID
    With m_DerefBlindDelegator
        If pEmbedded Then
            'Use the provided allocation
            ThisPtr = pEmbedded
            'Set a destruction pointer. The teardown code
            'keys off this value to determine if we are
            'using an embedded structure, so it must be
            'set to something even if no explicit callback
            'is provided.
            If pfnDestroyEmbedded = 0 Then pfnDestroyEmbedded = -1
        Else
            ThisPtr = CoTaskMemAlloc(LenB(.pSA(0)))
            If ThisPtr = 0 Then Err.Raise 7
            pfnDestroyEmbedded = 0 'Make sure this is zero so that we CoTaskMemFree
        End If
        .Owner.SA.pvData = ThisPtr
        With .pSA(0)
            .pfnDestroy = pfnDestroyEmbedded
            .pVTable = m_pBlindVTable
            .cRefs = 1
            PrivVBoost.AssignSwap .pInner, punkDelegatee
            PrivVBoost.AssignSwap .pOuter, punkOuter
        End With
    End With
    Exit Function
Error:
    CreateDelegator = MapError
End Function
Private Sub Blind_ResolveInner(pInner As IUnknown, ByVal pIID As VBGUIDPtr)
Dim pUnkUR As VBoostTypes.IUnknownUnrestricted
Dim pvObj As Long
Dim hr As Long
    PrivVBoost.AssignSwap pUnkUR, pInner
    With m_DerefIIDs
        .Owner.SA.pvData = pIID
        hr = pUnkUR.QueryInterface(.pSA(0), pvObj)
        If hr Then Err.Raise hr
    End With
    PrivVBoost.Assign pInner, pvObj
End Sub
Private Sub Blind_InitCode()
Dim Func As OneInt
Dim TwoBytes As TwoBytes
Dim Offset As Integer
Dim l As Long
    With m_BlindCode
        '4 longs for the Thunk code
        .ThunkAndQICode(0) = &H424448B
        .ThunkAndQICode(1) = &H8904408B
        .ThunkAndQICode(2) = &H8B042444
        .ThunkAndQICode(3) = &H824FF00
        '4 longs for the QI code
        .ThunkAndQICode(4) = &H424448B
        .ThunkAndQICode(5) = &H8908408B
        .ThunkAndQICode(6) = &H8B042444
        .ThunkAndQICode(7) = &HCC20FF00
        
        'Fill in first three vtable entries
        .VTable(0) = VarPtr(.ThunkAndQICode(4))
        .VTable(1) = FuncAddr(AddressOf Blind_AddRef)
        .VTable(2) = FuncAddr(AddressOf Blind_Release)
        
        'Initialize offsets, etc
        Func.I1 = 8
        Offset = -32
        For l = 3 To cBlindVTableEntries - 1
            Func.I1 = Func.I1 + 4
            LSet TwoBytes = Func
            Offset = Offset - 10
            With .Entries(l)
                .Bytes(0) = &HB9
                .Bytes(1) = TwoBytes.B1
                .Bytes(2) = TwoBytes.B2
                '3,4 remain 0
                .Bytes(5) = &HE9
                .Shorts(0) = Offset
                'This is really a long, but we don't get anywhere
                'near to changing the high half of the long to
                'anything other than &HFFFF
                .Shorts(1) = &HFFFF
            End With
            .VTable(l) = VarPtr(.Entries(l))
        Next l
        m_pBlindVTable = VarPtr(.VTable(0))
    End With
End Sub

Private Function Blind_AddRef(This As BlindDelegator) As Long
    With This
        .cRefs = .cRefs + 1
        Blind_AddRef = .cRefs
    End With
End Function
Private Function Blind_Release(This As BlindDelegator) As Long
    With This
        .cRefs = .cRefs - 1
        Blind_Release = .cRefs
        If .cRefs = 0 Then
            If .pfnDestroy Then
                Blind_Release = Blind_DestroyEmbeddedThis(This)
            Else
                Blind_Release = Blind_DestroyThis(This)
            End If
        End If
    End With
End Function
Private Function Blind_DestroyThis(This As BlindDelegator) As Long
Dim pOuter As IUnknownUnrestricted
    'Defer freeing outer until we're done with This,
    'it may be owned by outer.
    With SafeVBoost
        .AssignSwap pOuter, This.pOuter
        Set This.pInner = Nothing
        CoTaskMemFree VarPtr(This.pVTable)
        Blind_DestroyThis = pOuter.Release
        .AssignZero pOuter
    End With
End Function
Private Function Blind_DestroyEmbeddedThis(This As BlindDelegator) As Long
Dim pOuter As IUnknown
Dim pOuterUR As IUnknownUnrestricted
Dim pInner As IUnknown
Dim FD As FunctionDelegator
Dim pDestruct As ICallDestroyBlindDelegator
    With SafeVBoost
        'Defer freeing outer until we're done with This,
        'it may be owned by outer. Do this with SafeVBoost
        'in case we're in the middle of tearing down.
        .AssignSwap pInner, This.pInner
        .AssignSwap pOuter, This.pOuter
        If This.pfnDestroy <> -1 Then
            If m_pFunctionDelegatorVTable = 0 Then
                m_FunctionDelegatorASM = -368956918007638.6215@
                With m_FunctionDelegatorVTable
                    .VTable(0) = FuncAddr(AddressOf SayNo_QueryInterface)
                    .VTable(1) = FuncAddr(AddressOf AddRefRelease)
                    .VTable(2) = .VTable(1)
                    .VTable(3) = VarPtr(m_FunctionDelegatorASM)
                    m_pFunctionDelegatorVTable = VarPtr(.VTable(0))
                End With
            End If
            FD.pfn = This.pfnDestroy
            FD.pVTable = m_pFunctionDelegatorVTable
            .Assign pDestruct, VarPtr(FD)
            Blind_DestroyEmbeddedThis = pDestruct.Destroy(This, pInner, pOuter)
        End If
        Set pInner = Nothing
        If Not pOuter Is Nothing Then
            .AssignSwap pOuterUR, pOuter
            Blind_DestroyEmbeddedThis = pOuterUR.Release
            .AssignZero pOuterUR
        End If
    End With
End Function
#End If 'DO_BLIND

#If DO_FSMM Or DO_CFSMM Then
Private Function CreateFixedSizeMemoryManager(This As RootStruct, ByVal ElementSize As Long, ByVal ElementsPerBlock As Long, ByVal fCompactible As Boolean, retVal As Long) As Long
    If ElementSize < 1 Or ElementsPerBlock < 1 Then
        CreateFixedSizeMemoryManager = E_INVALIDARG
        retVal = 0
        Exit Function
    End If
    
    On Error GoTo Error
    retVal = 0
    If fCompactible Then
        #If DO_CFSMM Then
            retVal = CreateCompactibleFixedMemMgr(ElementSize, ElementsPerBlock)
        #Else
            Debug.Assert False 'Turn on VBOOST_MEMORY or VBOOST_MEMORY_COMPACTIBLE
        #End If
    Else
        #If DO_FSMM Then
            retVal = CreateFixedMemMgr(ElementSize, ElementsPerBlock)
        #Else
            Debug.Assert False 'Turn on VBOOST_MEMORY or VBOOST_MEMORY_SIMPLE
        #End If
    End If
    Exit Function
Error:
    CreateFixedSizeMemoryManager = MapError
End Function
'Functions shared by both objects
Private Function FSMMBase_AddRef(This As FSMMBase) As Long
    With This
        .cRefs = .cRefs + 1
        FSMMBase_AddRef = .cRefs
    End With
End Function
Private Function FSMMBase_Release(This As FSMMBase) As Long
    With This
        .cRefs = .cRefs - 1
        FSMMBase_Release = .cRefs
        If .cRefs = 0 Then
            FSMMBase_DeleteThis This
        End If
    End With
End Function
Private Sub FSMMBase_DeleteThis(This As FSMMBase)
Dim pBlock As Long
Dim pBlockNext As Long
#If DO_CFSMM Then
Dim fFreeLast As Boolean
    fFreeLast = This.pVTable = m_pCFSMMVTable
#End If
    'Free any additional blocks
    With This
        pBlockNext = .pFirstBlock
#If DO_CFSMM Then
        Do While pBlockNext 'While pBlockNext only required for Compactible case
#Else
        Do
#End If
            pBlock = pBlockNext
            
            'pBlockNext = *(void**)pBlock
            With m_DerefLong
                .Owner.SA.pvData = pBlock
                pBlockNext = .pSA(0)
            End With
            
            'Last block in chain is allocated with the This structure,
            'so don't free it directly
            If pBlockNext Then
                CoTaskMemFree pBlock
            Else
#If DO_CFSMM Then
                If fFreeLast Then CoTaskMemFree pBlock
#End If
                Exit Do
            End If
        Loop
    End With
    CoTaskMemFree VarPtr(This)
End Sub
Private Function FSMMBase_get_ElementSize(This As FSMMBase, retVal As Long) As Long
    retVal = This.ElemSize
End Function
Private Function FSMMBase_get_ElementsPerBlock(This As FSMMBase, retVal As Long) As Long
    retVal = This.ElemsPerBlock
End Function

Private Sub AlignSize(Size As Long)
'#define ALIGNED_SIZE(Size, AlignTo) (Size + (AlignTo - ((Size - 1) & (AlignTo - 1))) - 1)
Const PTRSIZE As Long = 4
    Size = Size + (PTRSIZE - ((Size - 1) And (PTRSIZE - 1))) - 1
End Sub
#End If 'DO_FSMM Or DO_CFSMM

#If DO_FSMM Then
Private Function CreateFixedMemMgr(ByVal ElementSize As Long, ByVal ElementsPerBlock As Long) As Long
Dim Struct As FixedMemMgr
Dim ThisPtr As Long
    If m_pFSMMVTable = 0 Then
        With m_FSMMVTable
            .VTable(0) = FuncAddr(AddressOf FSMM_QueryInterface)
            .VTable(1) = FuncAddr(AddressOf FSMMBase_AddRef)
            .VTable(2) = FuncAddr(AddressOf FSMMBase_Release)
            .VTable(3) = FuncAddr(AddressOf FSMM_Alloc)
            .VTable(4) = FuncAddr(AddressOf FSMM_Free)
            .VTable(5) = FuncAddr(AddressOf FSMMBase_get_ElementSize)
            .VTable(6) = FuncAddr(AddressOf FSMMBase_get_ElementsPerBlock)
            m_pFSMMVTable = VarPtr(.VTable(0))
        End With
        
        'Initialize our Deref array. We use this instead of VBoost
        'so that there isn't a VBoost dependency during teardown
        With m_DerefLong
            If .Owner.SA.cDims = 0 Then InitArrayOwner .Owner, LenB(.pSA(0))
        End With
    End If
    AlignSize ElementSize
    
    'Allocate first buffer with the object
    ThisPtr = CoTaskMemAlloc(LenB(Struct) + LenB(Struct.pFree) + ElementSize * ElementsPerBlock)
    If ThisPtr = 0 Then Err.Raise E_OUTOFMEMORY
    With Struct.Base
        .pVTable = m_pFSMMVTable
        .cRefs = 1
        .ElemSize = ElementSize
        .ElemsPerBlock = ElementsPerBlock
        Struct.cFreshItems = .ElemsPerBlock
        .pFirstBlock = PrivVBoost.UAdd(ThisPtr, LenB(Struct))
        PrivVBoost.AssignZero ByVal .pFirstBlock
        Struct.pFreshItem = PrivVBoost.UAdd(.pFirstBlock, LenB(Struct.pFree))
        CopyMemory ByVal ThisPtr, Struct, LenB(Struct)
    End With
    CreateFixedMemMgr = ThisPtr
End Function

'Functions for the non-compactible object
Private Function FSMM_QueryInterface(This As FixedMemMgr, riid As VBGUID, pvObj As Long) As Long
Dim fOK As BOOL
    Select Case riid.Data1
        Case Data1_IID_FixedSizeMemoryManager
            fOK = IsEqualIID(riid, IID_FixedSizeMemoryManager)
        Case Data1_IID_IUnknown
            fOK = IsEqualIID(riid, IID_IUnknown)
    End Select
    If fOK Then
        With This.Base
            pvObj = VarPtr(.pVTable)
            .cRefs = .cRefs + 1
        End With
    Else
        pvObj = 0
        FSMM_QueryInterface = E_NOINTERFACE
    End If
End Function
Private Function FSMM_Alloc(This As FixedMemMgr, retVal As Long) As Long
Dim pNewBlock As Long
    With This
        If .pFree Then
            retVal = .pFree
            .pFree = PrivVBoost.Deref(.pFree)
        Else
            If .cFreshItems = 0 Then
                'Get a new block of memory
                pNewBlock = CoTaskMemAlloc(LenB(pNewBlock) + .Base.ElemSize * .Base.ElemsPerBlock)
                If pNewBlock = 0 Then
                    FSMM_Alloc = E_OUTOFMEMORY
                    Exit Function
                End If
                
                'Chain it into the list of blocks
                PrivVBoost.Assign ByVal pNewBlock, .Base.pFirstBlock
                .Base.pFirstBlock = pNewBlock
                
                'Initialize our fresh items
                .cFreshItems = .Base.ElemsPerBlock
                .pFreshItem = PrivVBoost.UAdd(pNewBlock, LenB(pNewBlock))
            End If
            retVal = .pFreshItem
            .pFreshItem = PrivVBoost.UAdd(.pFreshItem, .Base.ElemSize)
            .cFreshItems = .cFreshItems - 1
        End If
        ZeroMemory ByVal retVal, .Base.ElemSize
    End With
End Function
Private Sub FSMM_Free(This As FixedMemMgr, ByVal pMemory As Long)
    '*(void**)pMemory = This.pFree
    With m_DerefLong
        .Owner.SA.pvData = pMemory
        .pSA(0) = This.pFree
    End With
    This.pFree = pMemory
End Sub
#End If 'DO_FSMM

#If DO_CFSMM Then
Private Function CreateCompactibleFixedMemMgr(ByVal ElementSize As Long, ByVal ElementsPerBlock As Long) As Long
Dim Struct As CompactibleFixedMemMgr
Dim ThisPtr As Long
    If m_pCFSMMVTable = 0 Then
        With m_CFSMMVTable
            .VTable(0) = FuncAddr(AddressOf CFSMM_QueryInterface)
            .VTable(1) = FuncAddr(AddressOf FSMMBase_AddRef)
            .VTable(2) = FuncAddr(AddressOf FSMMBase_Release)
            .VTable(3) = FuncAddr(AddressOf CFSMM_Alloc)
            .VTable(4) = FuncAddr(AddressOf CFSMM_Free)
            .VTable(5) = FuncAddr(AddressOf FSMMBase_get_ElementSize)
            .VTable(6) = FuncAddr(AddressOf FSMMBase_get_ElementsPerBlock)
            .VTable(7) = FuncAddr(AddressOf CFSMM_Compact)
            .VTable(8) = FuncAddr(AddressOf CFSMM_get_CompactOnFree)
            .VTable(9) = FuncAddr(AddressOf CFSMM_put_CompactOnFree)
            .VTable(10) = FuncAddr(AddressOf CFSMM_get_BufferBlocks)
            .VTable(11) = FuncAddr(AddressOf CFSMM_put_BufferBlocks)
            m_pCFSMMVTable = VarPtr(.VTable(0))
        End With
        
        'Initialize our DerefLong array. We use this instead of VBoost
        'so that there isn't a VBoost dependency during teardown
        With m_DerefLong
            If .Owner.SA.cDims = 0 Then InitArrayOwner .Owner, LenB(.pSA(0))
        End With
        
        'Initialize the derefing array for blocks
        With m_DerefCFSMMBlock
            InitArrayOwner .Owner, LenB(.pSA(0))
        End With
    End If
    
    ThisPtr = CoTaskMemAlloc(LenB(Struct))
    If ThisPtr = 0 Then Err.Raise E_OUTOFMEMORY
    
    'Adjust to get a reasonable alignment
    AlignSize ElementSize
    
    With Struct
        With .Base
            .pVTable = m_pCFSMMVTable
            .cRefs = 1
            .ElemsPerBlock = ElementsPerBlock
            .ElemSize = ElementSize
        End With
        .BlockSize = cCFSMMBlockBufferOffset + ElementSize * ElementsPerBlock
        .cBufferBlocks = 1
        CopyMemory ByVal ThisPtr, Struct, LenB(Struct)
    End With
    CreateCompactibleFixedMemMgr = ThisPtr
End Function

'Functions for the compactible object
Private Function CFSMM_QueryInterface(This As CompactibleFixedMemMgr, riid As VBGUID, pvObj As Long) As Long
Dim fOK As BOOL
    Select Case riid.Data1
        Case Data1_IID_CompactibleFixedSizeMemoryManager
            fOK = IsEqualIID(riid, IID_CompactibleFixedSizeMemoryManager)
        Case Data1_IID_FixedSizeMemoryManager
            fOK = IsEqualIID(riid, IID_FixedSizeMemoryManager)
        Case Data1_IID_IUnknown
            fOK = IsEqualIID(riid, IID_IUnknown)
    End Select
    If fOK Then
        With This.Base
            pvObj = VarPtr(.pVTable)
            .cRefs = .cRefs + 1
        End With
    Else
        pvObj = 0
        CFSMM_QueryInterface = E_NOINTERFACE
    End If
End Function
Private Function CFSMM_Alloc(This As CompactibleFixedMemMgr, retVal As Long) As Long
Dim pBlock As Long
Dim pBlockPrev As Long
Dim pNewBlock As Long
    'Find the first block with an available slot
    pBlock = This.Base.pFirstBlock
    With m_DerefCFSMMBlock
        Do While pBlock
            .Owner.SA.pvData = pBlock
            With .pSA(0)
                If .pFree Then
                    If .cInUse = 0 Then
                        This.cEmptyBlocks = This.cEmptyBlocks - 1
                    End If
                    'Move this block to the head of the list
                    'so the next search is more efficient.
                    If pBlockPrev Then
                        PrivVBoost.Assign ByVal pBlockPrev, .pNext 'pBlockPrev->pNext = pBlock->pNext;
                        .pNext = This.Base.pFirstBlock
                        This.Base.pFirstBlock = pBlock
                    End If
                    Exit Do
                End If
                pBlockPrev = pBlock
                pBlock = .pNext
            End With
        Loop
        
        'Allocate a new block if one isn't available
        If pBlock = 0 Then
            pNewBlock = CoTaskMemAlloc(This.BlockSize)
            If 0 = pNewBlock Then
                retVal = 0
                CFSMM_Alloc = E_OUTOFMEMORY
                Exit Function
            End If
            .Owner.SA.pvData = pNewBlock
            With .pSA(0)
                .pNext = This.Base.pFirstBlock
                This.Base.pFirstBlock = pNewBlock
                .cInUse = 0
                .fFreeIsList = False
                .pFree = PrivVBoost.UAdd(pNewBlock, cCFSMMBlockBufferOffset)
            End With
        End If
        
        'Get a piece of memory from the block.  This is
        'guaranteed to return valid memory at this point.
        With .pSA(0)
            retVal = .pFree
        
            'Update the free list for the block.
            .cInUse = .cInUse + 1
            If .cInUse = This.Base.ElemsPerBlock Then
                'All elements have been allocated, none are free.
                .pFree = 0&
            ElseIf .fFreeIsList Then
                'Grab the next item from the free list
                .pFree = PrivVBoost.Deref(.pFree)
                If 0 = .pFree Then
                    'Revert back to in order allocation if there are no
                    'more items in the free list.
                    .fFreeIsList = False
                    .pFree = PrivVBoost.UAdd(PrivVBoost.UAdd(pBlock, cCFSMMBlockBufferOffset), .cInUse * This.Base.ElemSize)
                End If
            Else
                'We're allocating in order
                .pFree = PrivVBoost.UAdd(.pFree, This.Base.ElemSize)
            End If
        End With
    End With

    'Zero out our allocated memory
    ZeroMemory ByVal retVal, This.Base.ElemSize
End Function
Private Sub CFSMM_Free(This As CompactibleFixedMemMgr, ByVal pMemory As Long)
Dim pBlock As Long
Dim pBlockPrev As Long
Dim fFound As Boolean
    pBlock = This.Base.pFirstBlock
    With SafeVBoost
        Do While pBlock
            If .UGT(pMemory, pBlock) Then
                If .UGT(.UAdd(pBlock, This.BlockSize), pMemory) Then
                    'We found the block, we're in business for the free
                    
                    'If this isn't the first block, then move it to the front of the
                    'list just like in the alloc case.  Allocs and Frees tend to happen
                    'in batches, and this will speed things significantly in the normal case.
                    'Note that pNext is the first element in a CFSMMBlock, so we don't
                    'need to use the deref array to modify it.
                    If pBlockPrev Then
                        .Assign ByVal pBlockPrev, ByVal pBlock 'pBlockPrev->pNext = pBlock->pNext;
                        .Assign ByVal pBlock, This.Base.pFirstBlock 'pBlock->pNext = m_pFirstBlock;
                        This.Base.pFirstBlock = pBlock
                    End If
                    Exit Do
                End If
            End If
            pBlockPrev = pBlock
            'pBlock = pBlock->pNext
            pBlock = .Deref(pBlock)
        Loop
    End With
    
    'If we found a block, then we're in business
    If pBlock Then
        With m_DerefCFSMMBlock
            .Owner.SA.pvData = pBlock
            With .pSA(0)
                'Use m_DerefLong instead of VBoost during teardown
                m_DerefLong.Owner.SA.pvData = pMemory
                If .fFreeIsList Then
                    '*(void**)pMemory = .pFree
                    m_DerefLong.pSA(0) = .pFree
                Else
                    '*(void**)pMemory = NULL
                    m_DerefLong.pSA(0) = 0&
                    .fFreeIsList = True
                End If
                .pFree = pMemory
                .cInUse = .cInUse - 1
                If 0 = .cInUse Then
                    With This
                        'This block is no longer in use.  See if we should
                        'free it right away.
                        If .fCompactOnFree And .cEmptyBlocks >= .cBufferBlocks Then
                            'We've already moved this block to the front, so relinking the
                            'list is trivial.
                            With m_DerefLong
                                .Owner.SA.pvData = pBlock
                                This.Base.pFirstBlock = .pSA(0)
                            End With
                            CoTaskMemFree pBlock
                        Else
                            .cEmptyBlocks = .cEmptyBlocks + 1
                        End If
                    End With
                End If
            End With
        End With
    End If
    'Note: Silent failure.  Free doesn't return an HRESULT for call speed
    'reasons, and CFixedMemMgr::Free can't return one anyway.
End Sub
Private Sub CFSMM_Compact(This As CompactibleFixedMemMgr)
Dim i As Integer
Dim pBlock As Long
Dim pBlockTmp As Long
Dim ppThisBlock As Long
    With This
        i = .cEmptyBlocks - .cBufferBlocks
        If i > 0 Then
            .cEmptyBlocks = .cEmptyBlocks - i
            pBlock = .Base.pFirstBlock
            ppThisBlock = VarPtr(.Base.pFirstBlock)
            With m_DerefCFSMMBlock
                'While (pBlock) is unnecessary here, the loop will exit before pBlock is NULL
                Do
                    .Owner.SA.pvData = pBlock
                    With .pSA(0)
                        If .cInUse = 0 Then
                            PrivVBoost.Assign ByVal ppThisBlock, .pNext
                            pBlockTmp = pBlock
                            pBlock = .pNext
                            CoTaskMemFree pBlockTmp
                            i = i - 1
                            If i = 0 Then
                                Exit Do
                            End If
                        Else
                            ppThisBlock = VarPtr(.pNext)
                            pBlock = .pNext
                        End If
                    End With
                Loop
            End With
        End If
    End With
End Sub
Private Function CFSMM_get_CompactOnFree(This As CompactibleFixedMemMgr, retVal As Boolean) As Long
    retVal = This.fCompactOnFree
End Function
Private Function CFSMM_put_CompactOnFree(This As CompactibleFixedMemMgr, ByVal RHS As Boolean) As Long
    This.fCompactOnFree = RHS
End Function
Private Function CFSMM_get_BufferBlocks(This As CompactibleFixedMemMgr, retVal As Integer) As Long
    retVal = This.cBufferBlocks
End Function
Private Function CFSMM_put_BufferBlocks(This As CompactibleFixedMemMgr, ByVal RHS As Integer) As Long
    If RHS < 0 Then
        CFSMM_put_BufferBlocks = E_INVALIDARG
    Else
        This.cBufferBlocks = RHS
    End If
End Function
#End If 'DO_CFSMM

#If DO_QIHOOK Then
'START_UNKNOWNHOOK_CODE
Private Function HookQI(This As RootStruct, ByVal pUnk As VBoostTypes.IUnknownUnrestricted, ByVal pQIHook As VBoostTypes.IQIHook, ByVal uhFlags As VBoostTypes.UnkHookFlags, ppOwner As Long) As Long
Dim pQIARHook As IQIARHook
    ppOwner = 0
    On Error GoTo Error
    PrivVBoost.AssignSwap pQIARHook, pQIHook
    CreateUnknownHook pUnk, pQIARHook, uhFlags, False, ppOwner
    Exit Function
Error:
    HookQI = MapError
End Function
#End If 'DO_QIHOOK
#If DO_QIARHOOK Then
Private Function HookQIAR(This As RootStruct, ByVal pUnk As VBoostTypes.IUnknownUnrestricted, ByVal pQIARHook As VBoostTypes.IQIARHook, ByVal uhFlags As VBoostTypes.UnkHookFlags, ppOwner As Long) As Long
    On Error GoTo Error
    ppOwner = 0
    CreateUnknownHook pUnk, pQIARHook, uhFlags, True, ppOwner
    Exit Function
Error:
    HookQIAR = MapError
End Function
#End If 'DO_QIARHOOK

#If DO_QIHOOK Or DO_QIARHOOK Then
Private Sub CreateUnknownHook(pUnk As VBoostTypes.IUnknownUnrestricted, QIARHook As VBoostTypes.IQIARHook, ByVal uhFlags As VBoostTypes.UnkHookFlags, ByVal fUseARHook As Boolean, ppOwner As Long)
    If m_pUnknownHookVTable = 0 Then
        InitArrayOwner m_DerefUnknownHook.Owner, 4
        With m_UnknownHookVTable
            .VTable(0) = FuncAddr(AddressOf UnknownHook_QueryInterface)
            .VTable(1) = FuncAddr(AddressOf UnknownHook_AddRef)
            .VTable(2) = FuncAddr(AddressOf UnknownHook_Release)
            .VTable(3) = FuncAddr(AddressOf UnknownHook_get_Flags)
            .VTable(4) = FuncAddr(AddressOf UnknownHook_put_Flags)
            m_pUnknownHookVTable = VarPtr(.VTable(0))
        End With
    End If
    With m_DerefUnknownHook
        .Owner.SA.pvData = CoTaskMemAlloc(LenB(.pSA(0)))
        If .Owner.SA.pvData = 0 Then Err.Raise 7
        ZeroMemory ByVal .Owner.SA.pvData, LenB(.pSA(0))
        With .pSA(0)
            .pVTable = m_pUnknownHookVTable
            .cRefs = 1
            QIARHookStruct_Hook .Hook, pUnk, QIARHook, uhFlags, False, fUseARHook, VarPtr(.pVTable)
            ppOwner = VarPtr(.pVTable)
        End With
    End With
End Sub
Private Function UnknownHook_QueryInterface(This As UnknownHookStruct, riid As VBGUID, pvObj As Long) As Long
Dim fOK As BOOL
    Select Case riid.Data1
        Case Data1_IID_UnknownHook
            fOK = IsEqualIID(riid, IID_UnknownHook)
        Case Data1_IID_IUnknown
            fOK = IsEqualIID(riid, IID_IUnknown)
    End Select
    If fOK Then
        With This
            pvObj = VarPtr(.pVTable)
            .cRefs = .cRefs + 1
        End With
    Else
        pvObj = 0
        UnknownHook_QueryInterface = E_NOINTERFACE
    End If
End Function
Private Function UnknownHook_AddRef(This As UnknownHookStruct) As Long
    With This
        .cRefs = .cRefs + 1
        UnknownHook_AddRef = .cRefs
    End With
End Function
Private Function UnknownHook_Release(This As UnknownHookStruct) As Long
    With This
        .cRefs = .cRefs - 1
        UnknownHook_Release = .cRefs
        If .cRefs = 0 Then
            QIARHookStruct_Unhook .Hook
            CoTaskMemFree VarPtr(.pVTable)
        End If
    End With
End Function
Private Function UnknownHook_get_Flags(This As UnknownHookStruct, puhFlags As UnkHookFlags) As Long
    With This.Hook
        puhFlags = .Flags And (uhBeforeQI Or uhAfterQI Or uhMapIIDs Or uhAddRef Or uhRelease)
    End With
End Function
Private Function UnknownHook_put_Flags(This As UnknownHookStruct, ByVal uhFlags As UnkHookFlags) As Long
Dim Mask As Long
    With This.Hook
        .Flags = .Flags And Not (hfHookQIAfter Or hfHookQIBefore Or hfMapIIDs Or hfReportAddRef Or hfReportRelease)
        Mask = hfHookQIAfter Or hfHookQIBefore Or hfMapIIDs
        If .Flags And hfARHook Then
            Mask = Mask Or hfReportAddRef Or hfReportRelease
        End If
        .Flags = .Flags Or (uhFlags And Mask)
    End With
End Function
#End If 'DO_QIHOOK Or DO_QIARHOOK

#If DO_HOOK Then
Private Sub QIARHookStruct_Hook(Hook As QIARHookStruct, pUnk As VBoostTypes.IUnknownUnrestricted, pQIARHook As IQIARHook, ByVal uhFlags As UnkHookFlags, ByVal fWeakRefQIHook As Boolean, ByVal fUseARHook As Boolean, ByVal pOwner As Long) 'UnknownHookStruct)
Dim pUnkVTable As Long
    With Hook
        If m_QIHookStructVTable.VTable(0) = 0 Then
            InitArrayOwner m_DerefQIARHook.Owner, 4
            With m_QIHookStructVTable
                .VTable(0) = FuncAddr(AddressOf QIARHook_QueryInterface)
                .VTable(1) = FuncAddr(AddressOf QIHook_AddRef)
                .VTable(2) = FuncAddr(AddressOf QIHook_Release)
                .VTable(3) = FuncAddr(AddressOf QIARHook_GetClassInfo)
            End With
        End If
#If DO_QIARHOOK Then
        If fUseARHook Then
            With m_QIARHookStructVTable
                If .VTable(0) = 0 Then
                    .VTable(0) = FuncAddr(AddressOf QIARHook_QueryInterface)
                    .VTable(1) = FuncAddr(AddressOf QIARHook_AddRef)
                    .VTable(2) = FuncAddr(AddressOf QIARHook_Release)
                    .VTable(3) = FuncAddr(AddressOf QIARHook_GetClassInfo)
                End If
            End With
            .VTable = m_QIARHookStructVTable
            If uhFlags And uhAddRef Then .Flags = .Flags Or hfReportAddRef
            If uhFlags And uhRelease Then .Flags = .Flags Or hfReportRelease
        Else
            .VTable = m_QIHookStructVTable
        End If
#Else
        .VTable = m_QIHookStructVTable
#End If
        PrivVBoost.Assign .pOuter, pUnk 'Not AddRefed
        .pVTableStart = PrivVBoost.Deref(PrivVBoost.Deref(VarPtr(pUnk)))
        If uhFlags And uhBeforeQI Then .Flags = .Flags Or hfHookQIBefore
        If uhFlags And uhAfterQI Then .Flags = .Flags Or hfHookQIAfter
        If uhFlags And uhMapIIDs Then .Flags = .Flags Or hfMapIIDs
        'fWeakRefQIHook is true if the object deriving from
        'CBaseUnkHook also implements the passed in QIHook.
        'If this isn't the case, then we need to make sure
        'that the QIHook is not on the same object as the
        'pass in controlling IUnknown.
        If fWeakRefQIHook Then
            .Flags = .Flags Or hfWeakQIHookExplicit
            PrivVBoost.Assign .pQIARHook, pQIARHook
        Else
            Set .pQIARHook = pQIARHook
            If pQIARHook Is pUnk Then
                .Flags = .Flags Or hfWeakQIHook
                pUnk.Release
            End If
        End If
        PrivVBoost.Assign .pOwner, pOwner
        'Release pUnk and pQIARHook before hooking so that we don't get
        'Release notifications leaving HookQI or HookQIAR.
        pUnkVTable = PrivVBoost.Deref(VarPtr(pUnk))
        Set pUnk = Nothing
        Set pQIARHook = Nothing
        PrivVBoost.Assign ByVal pUnkVTable, VarPtr(Hook)
    End With
End Sub
Private Sub QIARHookStruct_Unhook(Hook As QIARHookStruct)
Dim VBoost As VBoostRoot
    With Hook
        If Not .pOuter Is Nothing Then
            Set VBoost = SafeVBoost
            VBoost.Assign ByVal VBoost.Deref(VarPtr(.pOuter)), .pVTableStart
            If .Flags And hfWeakQIHookExplicit Then
                VBoost.AssignZero .pQIARHook
            Else
                If .Flags And hfWeakQIHook Then .pOuter.AddRef
                Set .pQIARHook = Nothing
            End If
            VBoost.AssignZero .pOuter
            VBoost.AssignZero .pOwner
        End If
    End With
End Sub

Private Function QIARHook_QueryInterface(pThis As Long, riid As VBGUID, pvObj As Long) As Long
Dim pResult As IUnknown
Dim punkOuter As IUnknown
Dim fOK As BOOL
Dim pHookedThis As Long
Dim iidUse As VBGUID
Dim VBoost As VBoostRoot
    pHookedThis = pThis
    'Copy the incoming IID.  We can't change iidUse directly,
    'so we copy it, enabling the MapIID call to not blow up.
    'The copy is unfortunate, but is is quicker than changing
    'the rest of the code to work with different IIDs.
    iidUse = riid
    With m_DerefQIARHook
        .Owner.SA.pvData = pThis
        pvObj = 0
        With .pSA(0)
            'Once the with context is pushed, changing the
            'underlying safearray is perfectly safe, so we
            'don't have to worry about reentrancy changing
            'pvData.
            pThis = .pVTableStart
            If .Flags And (hfHookQIBefore Or hfHookQIAfter Or hfMapIIDs) Then
                Set VBoost = SafeVBoost
                .pOwner.AddRef
                If .Flags And hfMapIIDs Then
                    On Error GoTo MapIIDError
                    'Raise an error out of MapIID to block the
                    'IID up front.
                    .pQIARHook.MapIID iidUse
                    On Error GoTo 0
                End If
                VBoost.Assign punkOuter, .pOuter
                If .Flags And hfHookQIBefore Then
                    On Error Resume Next
                    .pQIARHook.QIHook iidUse, uhBeforeQI, pResult, punkOuter
                    On Error GoTo 0
                End If
                If pResult Is Nothing Then
                    .pOuter.QueryInterface iidUse, pvObj
                    If pvObj Then VBoost.Assign pResult, pvObj
                End If
                If .Flags And hfHookQIAfter Then
                    On Error Resume Next
                    .pQIARHook.QIHook iidUse, uhAfterQI, pResult, punkOuter
                    On Error GoTo 0
                End If
                VBoost.AssignZero punkOuter
MapIIDCleanUp:
                If pResult Is Nothing Then
                    QIARHook_QueryInterface = E_NOINTERFACE
                Else
                    pvObj = 0
                    VBoost.AssignSwap pvObj, pResult
                End If
                If 0 = .pOwner.Release Then Exit Function
            Else
                QIARHook_QueryInterface = .pOuter.QueryInterface(iidUse, pvObj)
            End If
            If pvObj Then
                If pvObj = VarPtr(pThis) Then
                    Select Case iidUse.Data1
                        Case Data1_IID_IUnknown
                            fOK = IsEqualGUID(iidUse, IID_IUnknown)
                        Case Data1_IID_IProvideClassInfo
                            fOK = IsEqualGUID(iidUse, IID_IProvideClassInfo)
                        Case Else
                            fOK = BOOL_FALSE
                    End Select
                    If fOK = BOOL_FALSE Then
                        .pOuter.Release
                        pvObj = 0
                        QIARHook_QueryInterface = E_NOINTERFACE
                    End If
                End If
            End If
        End With
    End With
    pThis = pHookedThis
    Exit Function
MapIIDError:
    Resume MapIIDCleanUp
End Function

Private Function QIHook_AddRef(pThis As Long) As Long
Dim pHookedThis As Long
    pHookedThis = pThis
    With m_DerefQIARHook
        .Owner.SA.pvData = pThis
        With .pSA(0)
            pThis = .pVTableStart
            QIHook_AddRef = .pOuter.AddRef
        End With
    End With
    pThis = pHookedThis
End Function
Private Function QIHook_Release(pThis As Long) As Long
Dim pHookedThis As Long
    pHookedThis = pThis
    With m_DerefQIARHook
        .Owner.SA.pvData = pThis
        With .pSA(0)
            pThis = .pVTableStart
            QIHook_Release = .pOuter.Release
        End With
    End With
    'Only reset if not dead
    If QIHook_Release Then pThis = pHookedThis
End Function
Private Function QIARHook_GetClassInfo(pThis As Long, ppTI As Long) As Long
Dim pHookedThis As Long
    pHookedThis = pThis
    With m_DerefQIARHook
        .Owner.SA.pvData = pThis
        With .pSA(0)
            pThis = .pVTableStart
            QIARHook_GetClassInfo = .pOuter.GetClassInfo(ppTI)
        End With
    End With
    pThis = pHookedThis
End Function
#End If 'DO_HOOK

#If DO_QIARHOOK Then
Private Function QIARHook_AddRef(pThis As Long) As Long
Dim pHookedThis As Long
    pHookedThis = pThis
    With m_DerefQIARHook
        .Owner.SA.pvData = pThis
        With .pSA(0)
            pThis = .pVTableStart
            QIARHook_AddRef = .pOuter.AddRef
            If .Flags And hfReportAddRef Then
                .pOwner.AddRef
                .pQIARHook.AfterAddRef QIARHook_AddRef, VarPtr(pThis)
                If 0 = .pOwner.Release Then Exit Function
            End If
        End With
    End With
    pThis = pHookedThis
End Function
Private Function QIARHook_Release(pThis As Long) As Long
Dim pHookedThis As Long
Dim pOwner As VBoostTypes.IUnknownUnrestricted
    pHookedThis = pThis
    With m_DerefQIARHook
        .Owner.SA.pvData = pThis
        With .pSA(0)
            pThis = .pVTableStart
            If .Flags And hfReportRelease Then
                If .Flags And (hfWeakQIHook Or hfWeakQIHookExplicit) Then
                    'The QIHook is the same object as the hooked unknown.
                    'If the object dies, then there is no way to report
                    'the last release.
                    QIARHook_Release = .pOuter.Release
                    If QIARHook_Release Then
                        .pOwner.AddRef
                        .pQIARHook.AfterRelease QIARHook_Release, VarPtr(pThis)
                        If 0 = .pOwner.Release Then Exit Function
                    End If
                Else
                    'Grab the owner reference before Release is called
                    Set pOwner = .pOwner
                    QIARHook_Release = .pOuter.Release
                    .pQIARHook.AfterRelease QIARHook_Release, VarPtr(pThis)
                    If 0 = pOwner.Release Then
                        PrivVBoost.AssignZero pOwner
                        Exit Function
                    Else
                        PrivVBoost.AssignZero pOwner
                    End If
                End If
            Else
                QIARHook_Release = .pOuter.Release
            End If
        End With
    End With
    'Only reset if not dead
    If QIARHook_Release Then pThis = pHookedThis
End Function
#End If 'DO_QIARHOOK

#If DO_AGG Then
Private Sub InitAggregators()
    Debug.Assert Not m_fAggregatorsInit
    
    'Set up our pointer derefing arrays
    With m_DerefIIDs
        'Also set in by CreateDelegator code, may be initialized already
        If .Owner.SA.cDims = 0 Then InitArrayOwner .Owner, LenB(.pSA(0))
    End With
    With m_DerefCHoldUnk
        InitArrayOwner .Owner, LenB(.pSA(0))
    End With
    With m_DerefIIDHookNode
        InitArrayOwner .Owner, LenB(.pSA(0))
    End With
    #If DO_AGGCREATE Then
        With m_DerefAggregateObject
            InitArrayOwner .Owner, LenB(.pSA(0))
        End With
        With m_AggregateObjectVTable
            .VTable(0) = FuncAddr(AddressOf CAggregateObject_QueryInterface)
            .VTable(1) = FuncAddr(AddressOf CAggregateObject_AddRef)
            .VTable(2) = FuncAddr(AddressOf CAggregateObject_Release)
            m_pAggregateObjectVTable = VarPtr(.VTable(0))
        End With
    #End If
    #If DO_AGGUNK Then
        With m_DerefUnkHookAggregate
            InitArrayOwner .Owner, LenB(.pSA(0))
        End With
        With m_UnkHookAggregateVTables
            .VTable(0) = FuncAddr(AddressOf CUnkHookAggregate_QueryInterface)
            .VTable(1) = FuncAddr(AddressOf CUnkHookAggregate_AddRef)
            .VTable(2) = FuncAddr(AddressOf CUnkHookAggregate_Release)
            .VTable(3) = FuncAddr(AddressOf CUnkHookAggregate_get_Flags)
            .VTable(4) = FuncAddr(AddressOf CUnkHookAggregate_put_Flags)
            m_pUnkHookAggregateVTable = VarPtr(.VTable(0))
            .IQIHookVTable(0) = FuncAddr(AddressOf CUnkHookAggregate_IQIHook_QueryInterface)
            .IQIHookVTable(1) = FuncAddr(AddressOf CUnkHookAggregate_IQIHook_AddRef)
            .IQIHookVTable(2) = FuncAddr(AddressOf CUnkHookAggregate_IQIHook_Release)
            .IQIHookVTable(3) = FuncAddr(AddressOf CUnkHookAggregate_IQIHook_QIHook)
            .IQIHookVTable(4) = FuncAddr(AddressOf CUnkHookAggregate_IQIHook_MapIID)
            m_pUnkHookAggregateIQIHookVTable = VarPtr(.IQIHookVTable(0))
        End With
    #End If
    
    m_fAggregatorsInit = True
End Sub

Private Sub CAggregator_Initialize(This As CAggregator, pAggData() As AggregateData, ByVal cAggElems As Long, pIIDs() As IID, PAD As PreAllocData, punkControlling As VBoostTypes.IUnknownUnrestricted)
Dim iCurData As Long       'A loop counter for the current element in pAggData
Dim cElems As Long         'A local for counting elements
Dim cFiltered As Long      'The number of encountered filtered objects.  Order in these doesn't matter, so they're tossed at the end.
Dim iCurEntry As Long      'The location in the pHoldUnks array where the current element is stored
Dim iCurIID As Long        'A loop iterator for items in the IID array
Dim pCurMap As Long 'IIDMapEntry* 'The current position in the pIIDMaps array
Dim pCurBlockIID As Long 'pCurBlockIID 'The current position in the pBlockIIDs array
Dim Flags As ADFlags       'Flags local
Dim pDelay As IDelayCreation 'Delayed creation
Dim pvObj As Long          'Long for QI call
Dim iNodesList As Long      'Set to ciBeforeNodes or ciAfterNodes
Dim pUnkUR As IUnknownUnrestricted 'A temporary variable to handle weak ref cases

    With This
        IIDHookNodeList_Initialize .NodesList(ciBeforeNodes)
        IIDHookNodeList_Initialize .NodesList(ciAfterNodes)
        .cIIDMaps = PAD.cIIDMaps
        .cBlockIIDs = PAD.cIIDBlocks
        .cHoldUnks = cAggElems - PAD.cIIDMapAndBlockElems
        
        'Start allocating extra memory
        'Try to alloc enough to get us through this routine up front,
        'plus two slots for each unfiltered item.  If this succeeds, then
        'we don't have to worry about FSMM->Alloc calls failing in this routine.
        If CBool(PAD.cIIDs) Or (PAD.cUnfiltered - PAD.cUnfilteredNoDelegator) Then
            cElems = PAD.cIIDs
            iCurEntry = PAD.cUnfiltered - PAD.cUnfilteredNoDelegator
            If iCurEntry Then
                cElems = cElems + 2 * iCurEntry
                If cElems < 4 Then cElems = 4
            End If
            Set .pFSMMNodes = PrivVBoost.CreateFixedSizeMemoryManager(LenB(m_DerefIIDHookNode.pSA(0)), cElems)
        End If

        If .cHoldUnks Then
            .pHoldUnks = PAD.pExtraBytes
            PAD.pExtraBytes = PrivVBoost.UAdd(PAD.pExtraBytes, .cHoldUnks * LenB(m_DerefCHoldUnk.pSA(0)))
            With m_DerefCHoldUnk.Owner.SA
                .cElements = This.cHoldUnks
                .pvData = This.pHoldUnks
            End With
        End If
        If .cIIDMaps Then
            'These are sufficiently constructed with the ZeroMemory on
            'the extra bytes
            .pIIDMaps = PAD.pExtraBytes
            pCurMap = .pIIDMaps
            PAD.pExtraBytes = PrivVBoost.UAdd(PAD.pExtraBytes, .pIIDMaps * 2 * LenB(m_DerefIIDs.pSA(0)))
        End If
    
        If .cBlockIIDs Then
            .pBlockIIDs = PAD.pExtraBytes
            pCurBlockIID = .pBlockIIDs
        End If
        .cUnfilteredBefore = 0
        .cUnfilteredAfter = 0
    End With


    'Now, actually fill the arrays
    iCurData = LBound(pAggData)
    For iCurData = iCurData To cAggElems + iCurData - 1
        With pAggData(iCurData)
            Flags = .Flags
            If Not .pObject Is Nothing Then
                If Flags And adDontQuery Then
                    'Just toss it near the end of the list.  This entry won't be referenced by
                    'any IIDData, so it doesn't hurt anything.
                    PrivVBoost.AssignAddRef m_DerefCHoldUnk.pSA(This.cHoldUnks - cFiltered - 1).pUnk, .pObject
                    cFiltered = cFiltered + 1
                Else
                    If Flags And adUseIIDs Then
                        'We have a filtered item (it gets sent only predefined IIDs)
    
                        'Find out how many IIDs we have.
                        'Ignore LastIID if Last < First
                        If .LastIID <= .FirstIID Then
                            cElems = 1
                        Else
                            cElems = .LastIID - .FirstIID + 1
                        End If
                        
                        'We just throw this anywhere at the end of the array.
                        iCurEntry = This.cHoldUnks - cFiltered - 1
                        cFiltered = cFiltered + 1
                        If Flags And adBeforeHookedUnknown Then
                            iNodesList = ciBeforeNodes
                        Else
                            iNodesList = ciAfterNodes
                        End If
                        For iCurIID = .FirstIID To .FirstIID + cElems - 1
                            'FSMM allocates the first chunk with the object,
                            'so this can't fail.
                            With m_DerefIIDHookNode
                                .Owner.SA.pvData = This.pFSMMNodes.Alloc()
                                With .pSA(0)
                                    .IID = pIIDs(iCurIID)
                                    .iUnk = iCurEntry
                                End With
                                IIDHookNodeList_AddTail This.NodesList(iNodesList), .pSA(0)
                            End With
                        Next iCurIID
    
                        With m_DerefCHoldUnk.pSA(iCurEntry)
                            'The delayed creation flag is ignored if no IID's are specified, so
                            'we must check it in here.
                            If Flags And adDelayCreation Then
                                'If we're delaying creation, then there's some
                                'more work to do.
                                Set pDelay = pAggData(iCurData).pObject
                                PrivVBoost.AssignAddRef .pUnk, pDelay
                                If punkControlling Is pDelay Then
                                    .Flags = .Flags Or fWeakRef
                                    punkControlling.Release
                                End If
                                .Flags = .Flags Or fDelayedCreation
                                If (Flags And adDelayDontCacheResolved) = adDelayDontCacheResolved Then 'Two bit field, need = compare
                                    .Flags = .Flags Or fKeepDelayed
                                End If
                                Set pDelay = Nothing
                                
                                If Flags And adWeakRefBalanced Then
                                    .Flags = .Flags Or fWeakRefExplicit
                                ElseIf Flags And adWeakRefRaw Then
                                    .Flags = .Flags Or fWeakRefRaw
                                End If
                            End If
                        
                            'Flag if we're fully resolved. This applies to items that
                            'are delay created as well as items with a single IID.
                            If Flags And adFullyResolved Then
                                .Flags = .Flags Or fFullyResolved
                            End If
                        End With
                    Else
                        'This is an unfiltered item (it gets blindly sent IIDs)
                        If Flags And adBeforeHookedUnknown Then
                            iCurEntry = This.cUnfilteredBefore
                            This.cUnfilteredBefore = This.cUnfilteredBefore + 1
                        Else
                            iCurEntry = PAD.cUnfilteredBefore + This.cUnfilteredAfter
                            This.cUnfilteredAfter = This.cUnfilteredAfter + 1
                        End If
                    End If
                    
                    With m_DerefCHoldUnk.pSA(iCurEntry)
                        'Share object assignment code for both filtered and blind cases.
                        If 0 = (Flags And adDelayCreation) Then
                            If Flags And adWeakRefRaw Then
                                PrivVBoost.Assign .pUnk, pAggData(iCurData).pObject
                                .Flags = .Flags Or fWeakRefRaw
                            Else
                                PrivVBoost.AssignAddRef .pUnk, pAggData(iCurData).pObject
                                If Flags And adWeakRefBalanced Then
                                    On Error Resume Next
                                    'Use different IUnknown types to force QI
                                    Set pUnkUR = pAggData(iCurData).pObject
                                    On Error GoTo 0
                                    If Not pUnkUR Is Nothing Then
                                        pUnkUR.Release
                                        Set pUnkUR = Nothing
                                        .Flags = .Flags Or fWeakRef
                                    End If
                                End If
                            End If
                        End If

                        'See if the blind delegation has been
                        'explicitly turned off.
                        If Flags And adNoDelegator Then
                            .Flags = .Flags Or fNoDelegator
                        End If
        
                        'If we found a primary dispatch request
                        'during the initial pass and we haven't found
                        'one yet, then deal with it the same as a
                        'before request.  An IDispatch can come on
                        'a filtered or unfiltered object, and be before
                        'or after.
                        If PAD.fHaveDispHook And CBool(Flags And adPrimaryDispatch) Then
                            With m_DerefIIDHookNode
                                .Owner.SA.pvData = This.pFSMMNodes.Alloc()
                                With .pSA(0)
                                    .IID = IID_IDispatch
                                    .iUnk = iCurEntry
                                End With
                                IIDHookNodeList_AddTail This.NodesList(ciBeforeNodes), .pSA(0)
                            End With
                            PAD.fHaveDispHook = False
                        End If
                    End With
                End If
            ElseIf PAD.fHaveDispHook And ((Flags And (adPrimaryDispatch Or adUseIIDs)) = (adPrimaryDispatch Or adUseIIDs)) Then
                'This is a special case.  We're remapping the
                'primary dispatch of the controlling IUnknown to a secondary
                'interface on the controlling IUnknown.  This requires a
                'QI at this point, a WeakRef on the holder, and a flag
                'indicating that a QI should not be done during the QueryInterface
                'call.
                If 0 = punkControlling.QueryInterface(pIIDs(.FirstIID), pvObj) Then
                    iCurEntry = This.cHoldUnks - cFiltered - 1
                    cFiltered = cFiltered + 1
                    With m_DerefIIDHookNode
                        .Owner.SA.pvData = This.pFSMMNodes.Alloc()
                        With .pSA(0)
                            .IID = IID_IDispatch
                            .iUnk = iCurEntry
                        End With
                        IIDHookNodeList_AddTail This.NodesList(ciBeforeNodes), .pSA(0)
                    End With
                    With m_DerefCHoldUnk.pSA(iCurEntry)
                        .Flags = .Flags Or fWeakRef Or fFullyResolved
                        PrivVBoost.Assign .pUnk, pvObj 'pUnk gets ref count
                        punkControlling.Release 'Balance QI call to match weakref
                    End With
                    PAD.fHaveDispHook = False
                Else
                    Err.Raise DISP_E_TYPEMISMATCH
                End If
            ElseIf Flags And adMapIID Then
                With m_DerefIIDs
                    .Owner.SA.pvData = pCurMap
                    .Owner.SA.cElements = 3
                    '0 slot is FromIID
                    .pSA(0) = pIIDs(pAggData(iCurData).FirstIID)
                    '1 slot is ToIID
                    .pSA(1) = pIIDs(pAggData(iCurData).LastIID)
                    '2 slot is FromIID. We're only storing the address,
                    'so we don't actually care if we have one of these
                    'or not.
                    pCurMap = VarPtr(.pSA(2))
                End With
            ElseIf Flags And adBlockIIDs Then
                If .LastIID <= .FirstIID Then
                    cElems = 1
                Else
                    cElems = .LastIID - .FirstIID + 1
                End If
                iCurEntry = .FirstIID
                With m_DerefIIDs
                    .Owner.SA.cElements = cElems + 1
                    .Owner.SA.pvData = pCurBlockIID
                    For iCurIID = 0 To cElems - 1
                        .pSA(iCurIID) = pIIDs(iCurEntry + iCurIID)
                    Next iCurIID
                    'Move to the next item
                    pCurBlockIID = VarPtr(.pSA(cElems))
                End With
            End If
        End With
    Next iCurData
End Sub
Private Sub CAggregator_Terminate(This As CAggregator)
Dim i As Long
    With This
        If .pHoldUnks Then
            'Run termination code for each item
            i = .cHoldUnks
            With m_DerefCHoldUnk
                .Owner.SA.cElements = i
                .Owner.SA.pvData = This.pHoldUnks
                For i = 0 To i - 1
                    CHoldUnk_Terminate .pSA(i)
                Next i
            End With
        End If
        If Not .pFSMMNodes Is Nothing Then
            For i = ciBeforeNodes To ciAfterNodes
                CAggregator_OnTerminateAggregator This, .NodesList(i)
            Next i
            Set .pFSMMNodes = Nothing
        End If
    End With
End Sub
Private Sub CAggregator_OnTerminateAggregator(This As CAggregator, NodeList As IIDHookNodeList)
Dim pCur As Long
Dim pfn As Long
    pfn = FuncAddr(AddressOf IIDHookNode_PostMortemDestruct)
    pCur = NodeList.pHead
    With m_DerefIIDHookNode
        Do While pCur
            .Owner.SA.pvData = pCur
            With .pSA(0)
                If .BlindDel.cRefs Then
                    Set .pFSMMOwner = This.pFSMMNodes
                    .BlindDel.pfnDestroy = pfn
                End If
                pCur = .pNext
            End With
        Loop
    End With
End Sub
'Do all the work for an IQIHook_QIHook callback
'Function should return an HRESULT, not raise an error
Private Function CAggregator_DoQIHook(This As CAggregator, riid As IID, pNodeToWrap As Long, ByVal fAfter As Boolean, ppResult As IUnknown) As Long
Dim iNodesList As Long
Dim pCurNode As Long
Dim i As Integer
Dim iEnd As Integer
Dim pResolved As VBoostTypes.IUnknownUnrestricted
Dim fOK As Boolean
Dim pvObj As Long
    
    'First, walk the filtered before values
    If fAfter Then
        iNodesList = ciAfterNodes
    Else
        iNodesList = ciBeforeNodes
    End If
    pCurNode = This.NodesList(iNodesList).pHead

    Do While pCurNode
        With m_DerefIIDHookNode
            .Owner.SA.pvData = pCurNode
            With .pSA(0)
                'Quick check first
                If riid.Data1 = .IID.Data1 Then
                    If IsEqualIID(riid, .IID) Then
                        If .BlindDel.cRefs Then
                            'Do the assignment without AssignAddRef, then increment
                            'the reference count by hand to complete the AddRef.
                            PrivVBoost.Assign ppResult, VarPtr(.BlindDel.pVTable)
                            .BlindDel.cRefs = .BlindDel.cRefs + 1
                            'Don't set pNodeToWrap, there's nothing more to be done
                            'with this value.
                            Exit Function
                        Else
                            i = .iUnk
                            With m_DerefCHoldUnk
                                .Owner.SA.cElements = 1
                                With .pSA(0)
                                    If .Flags And fDelayedCreation Then
                                        On Error Resume Next
                                        PrivVBoost.AssignSwap pResolved, CHoldUnk_ResolveDelayedCreation(m_DerefCHoldUnk.pSA(0), riid)
                                        On Error GoTo 0
                                    End If
                                    If (0 = (.Flags And fDelayedCreation)) Or _
                                       (Not pResolved Is Nothing) Then
                                       If Not pResolved Is Nothing Then
                                            'In this case, rUnkHold still holds the IDelayedCreation
                                            'interface reference, so we QI the returned object.
                                            If .Flags And fFullyResolved Then
                                                PrivVBoost.AssignSwap ppResult, pResolved
                                                fOK = True
                                            Else
                                                If 0 = pResolved.QueryInterface(riid, pvObj) Then
                                                    fOK = True
                                                    PrivVBoost.Assign ppResult, pvObj
                                                End If
                                            End If
                                            Set pResolved = Nothing
                                       ElseIf .Flags And fFullyResolved Then
                                            'No QI is necessary (generally an IDispatch call)
                                            PrivVBoost.AssignAddRef ppResult, .pUnk
                                            fOK = True
                                       Else
                                            'Do a normal QueryInterface
                                            If 0 = .pUnk.QueryInterface(riid, pvObj) Then
                                                PrivVBoost.Assign ppResult, pvObj
                                                fOK = True
                                            End If
                                       End If
                                    End If
                                    
                                    If fOK Then
                                        If 0 = (.Flags And fNoDelegator) Then
                                            pNodeToWrap = pCurNode
                                        End If
                                        Exit Function
                                    End If
                                End With
                            End With
                        End If
                    End If
                End If
                pCurNode = .pNext
            End With
        End With
    Loop

    'Now try all the unfiltered objects
    'Before loop: for i = 0 To cUnfilteredBefore - 1
    'After loop:  for i = cUnfilteredBefore To cUnfilteredBefore + cUnfilteredAfter - 1
    With This
        If fAfter Then
            i = .cUnfilteredBefore
            iEnd = .cUnfilteredBefore + .cUnfilteredAfter - 1
        Else
            i = 0
            iEnd = .cUnfilteredBefore - 1
        End If
    End With
    If iEnd >= i Then
        With m_DerefCHoldUnk
            .Owner.SA.pvData = This.pHoldUnks
            .Owner.SA.cElements = This.cHoldUnks
            For i = i To iEnd
                If 0 = .pSA(i).pUnk.QueryInterface(riid, pvObj) Then
                    PrivVBoost.Assign ppResult, pvObj
                    If 0 = (.pSA(i).Flags And fNoDelegator) Then
                        With m_DerefIIDHookNode
                            With .Owner.SA
                                .pvData = 0
                                On Error Resume Next
                                .pvData = This.pFSMMNodes.Alloc
                                On Error GoTo 0
                                If .pvData = 0 Then
                                    Set ppResult = Nothing
                                    CAggregator_DoQIHook = E_OUTOFMEMORY
                                    Exit Function
                                End If
                            End With
                            'FSMM does a ZeroMemory, so we don't have
                            'much to initialize.
                            IIDHookNodeList_AddTail This.NodesList(iNodesList), .pSA(0)
                            With .pSA(0)
                                .IID = riid
                                .iUnk = i
                                pNodeToWrap = VarPtr(.BlindDel)
                            End With
                        End With
                    End If
                    Exit Function
                End If
            Next i
        End With
    End If
    CAggregator_DoQIHook = E_NOINTERFACE
End Function
'Map or block an IID, the worker for the IQIHook_MapIID callback.
'Function should return an HRESULT, not raise an error
Private Function CAggregator_DoMapIID(This As CAggregator, pIID As IID) As Long
Dim i As Long

    'First check the block list
    i = This.cBlockIIDs
    If i Then
        With m_DerefIIDs
            .Owner.SA.cElements = i
            .Owner.SA.pvData = This.pBlockIIDs
            For i = 0 To i - 1
                If .pSA(i).Data1 = pIID.Data1 Then
                    If IsEqualIID(.pSA(i), pIID) Then
                        CAggregator_DoMapIID = E_NOINTERFACE
                        Exit Function
                    End If
                End If
            Next i
        End With
    End If
    
    'Now check the mapping list
    i = This.cIIDMaps
    If i Then
        With m_DerefIIDs
            .Owner.SA.cElements = 2 * i
            .Owner.SA.pvData = This.pIIDMaps
            'IIDFrom is slot i, IIDTo is slot i + 1
            For i = 0 To 2 * i - 1 Step 2
                If .pSA(i).Data1 = pIID.Data1 Then
                    If IsEqualIID(.pSA(i), pIID) Then
                        pIID = .pSA(i + 1)
                        Exit For
                    End If
                End If
            Next i
        End With
    End If
End Function
Private Function CAggregator_GetFlags(This As CAggregator) As UnkHookFlags
Dim Flags As UnkHookFlags
    With This
        If CBool(.cUnfilteredBefore) Or .NodesList(ciBeforeNodes).pHead Then
            Flags = Flags Or uhBeforeQI
        End If
        If CBool(.cUnfilteredAfter) Or .NodesList(ciAfterNodes).pHead Then
            Flags = Flags Or uhAfterQI
        End If
        If CBool(.pIIDMaps) Or .pBlockIIDs Then
            Flags = Flags Or uhMapIIDs
        End If
    End With
    CAggregator_GetFlags = Flags
End Function

Private Sub CHoldUnk_Terminate(This As CHoldUnk)
Dim pvObj As Long
    With This
        If 0 = (.Flags And fWeakRefRaw) Then
            'There's no need to clear the .pUnk variable
            'if its a raw weak reference because this
            'whole memory block is about to be blown away.
            If Not .pUnk Is Nothing Then
                If .Flags And fWeakRef Then
                    'Add a reference back to the controlling IUnknown
                    .pUnk.QueryInterface IID_IUnknown, pvObj
                End If
                Set .pUnk = Nothing
            End If
        End If
    End With
End Sub

'Call IDelayCreation::Create, replacing m_pUnk with
'the resolved value if successful.  If m_fKeepDelayed
'is true, then *ppResolved returns an AddRefed pointer
'to the resolved interface.  Otherwise, use operator->
'directly to get at the IUnknown.
Private Function CHoldUnk_ResolveDelayedCreation(This As CHoldUnk, riid As IID) As IUnknown
Dim pDelayCreation As IDelayCreation
Dim pUnkResolved As IUnknown
Dim pvObj As Long
Dim pUnkUR As IUnknownUnrestricted
    With This
        PrivVBoost.AssignAddRef pDelayCreation, .pUnk
        Set pUnkResolved = pDelayCreation.Create(riid)
        If pUnkResolved Is Nothing Then Err.Raise E_NOINTERFACE
        If .Flags And fKeepDelayed Then
            PrivVBoost.AssignSwap CHoldUnk_ResolveDelayedCreation, pUnkResolved
        Else
            If .Flags And fWeakRef Then
                'Balance the missing ref on the controlling IUnknown
                .pUnk.QueryInterface IID_IUnknown, pvObj
            End If
            Set .pUnk = Nothing
            .Flags = .Flags And Not (fDelayedCreation Or fWeakRef)
            PrivVBoost.AssignSwap .pUnk, pUnkResolved
        
            'This should be held as a weak reference. (Re)establish the fWeakRef flag.
            If .Flags And fWeakRefExplicit Then
                pvObj = 0
                .pUnk.QueryInterface IID_IUnknown, pvObj
                If pvObj Then
                    PrivVBoost.AssignSwap pUnkUR, pvObj
                    'Balance the QI call
                    pUnkUR.Release
                    'Enter the WeakRef state
                    Set pUnkUR = Nothing
                    .Flags = .Flags Or fWeakRef
                End If
            End If
        End If
    End With
End Function
Private Sub IIDHookNodeList_Initialize(This As IIDHookNodeList)
    This.ppTail = VarPtr(This.pHead)
End Sub
Private Sub IIDHookNodeList_AddTail(This As IIDHookNodeList, pNode As IIDHookNode)
    PrivVBoost.Assign ByVal This.ppTail, VarPtr(pNode)
    This.ppTail = VarPtr(pNode.pNext)
End Sub

'This is swapped into the delegator as the destructor to use
'after the aggregator is no longer alive.
Private Function IIDHookNode_PostMortemDestruct(Node As IIDHookNode, pInner As IUnknown, pOuter As IUnknown) As UINT
    Set Node.pFSMMOwner = Nothing
End Function
Private Sub PreAllocData_Initialize(PAD As PreAllocData, AggData() As AggregateData, ByVal cAggElems As Long, ByVal cIIDElems As Long)
Dim iCurData As Long       'Loop counter
Dim cElems As Long         'A local for counting elements
Dim Flags As ADFlags       'Flags local
    iCurData = LBound(AggData)
    For iCurData = iCurData To cAggElems + iCurData - 1
        With AggData(iCurData)
            If .FirstIID < 0 Or .LastIID < 0 Then Err.Raise DISP_E_BADINDEX
            Flags = .Flags
            'If we have an object, then we always count the entry
            If (Not .pObject Is Nothing) And (0 = (Flags And adDontQuery)) Then
                'Do some flag validation. You can't specify both of these.
                If (Flags And (adWeakRefRaw Or adWeakRefBalanced)) = (adWeakRefRaw Or adWeakRefBalanced) Then
                    Err.Raise E_INVALIDARG
                End If

                If Flags And adPrimaryDispatch Then
                    With PAD
                        If Not .fHaveDispHook Then
                            .cIIDs = .cIIDs + 1
                            .fHaveDispHook = True
                        End If
                    End With
                End If
                If Flags And adUseIIDs Then
                    'Ignore LastIID if Last < First
                    If .LastIID <= .FirstIID Then
                        cElems = 1
                    Else
                        cElems = .LastIID - .FirstIID + 1
                    End If
                    If ((Flags And adFullyResolved) And cElems <> 1) Or _
                       ((cElems + .FirstIID) > cIIDElems) Then
                        Err.Raise DISP_E_BADINDEX
                    End If
                    PAD.cIIDs = PAD.cIIDs + cElems
                Else
                    'Can't delay create without adUseIIDs
                    If Flags And adDelayCreation Then Err.Raise E_INVALIDARG
                    
                    With PAD
                        .cUnfiltered = .cUnfiltered + 1
                        If Flags And adBeforeHookedUnknown Then
                            .cUnfilteredBefore = .cUnfilteredBefore + 1
                        End If
                        If Flags And adNoDelegator Then
                            .cUnfilteredNoDelegator = .cUnfilteredNoDelegator + 1
                        End If
                    End With
                End If
            'If we don't have an object, then this is an attempt to
            'change the primary dispatch to something other than the primary object.
            ElseIf (.pObject Is Nothing) And _
                   ((Flags And (adPrimaryDispatch Or adUseIIDs)) = (adPrimaryDispatch Or adUseIIDs)) And _
                   Not PAD.fHaveDispHook Then
                'We only use the first IID
                If .FirstIID >= cIIDElems Then
                    Err.Raise DISP_E_BADINDEX
                End If
                With PAD
                    .cIIDs = .cIIDs + 1
                    .fHaveDispHook = True
                End With
            ElseIf Flags And adMapIID Then
                If .FirstIID >= cIIDElems Or .LastIID >= cIIDElems Then
                    Err.Raise DISP_E_BADINDEX
                End If
                With PAD
                    .cIIDMaps = .cIIDMaps + 1
                    .cIIDMapAndBlockElems = .cIIDMapAndBlockElems + 1
                End With
            ElseIf Flags And adBlockIIDs Then
                'Ignore LastIID if Last < First
                If .LastIID <= .FirstIID Then
                    cElems = 1
                Else
                    cElems = .LastIID - .FirstIID + 1
                End If
                If (cElems + .FirstIID) > cIIDElems Then
                    Err.Raise DISP_E_BADINDEX
                End If
                With PAD
                    .cIIDBlocks = .cIIDBlocks + cElems
                    .cIIDMapAndBlockElems = .cIIDMapAndBlockElems + 1
                End With
            End If
        End With
    Next iCurData
    
    'Figure out bytes count for the Unknown elements, as well as the
    'IID maps.  These are all of the items in CAggregator that are
    'created with the object instead of the FSMM.
    With PAD
        .cExtraBytes = (cAggElems - .cIIDMapAndBlockElems) * LenB(m_DerefCHoldUnk.pSA(0)) _
                   + .cIIDMaps * 2 * LenB(m_DerefIIDs.pSA(0)) _
                   + .cIIDBlocks * LenB(m_DerefIIDs.pSA(0))
    End With
End Sub
#End If 'DO_AGG

#If DO_AGGUNK Then
'CUnkHookAggregate implementation
Private Function AggregateUnknown(This As RootStruct, ByVal pUnk As stdole.IUnknown, pAggData() As AggregateData, pIIDs() As VBoostTypes.VBGUID, ppOwner As Long) As Long
Dim cAggElems As Long
Dim cIIDs As Long
Dim PAD As PreAllocData
Dim pAlloc As Long
Dim pUnkUR As VBoostTypes.IUnknownUnrestricted
Dim pQIARHook As IQIARHook
    On Error GoTo Error
    ppOwner = 0
    If Not m_fAggregatorsInit Then InitAggregators
    cAggElems = UBound(pAggData) - LBound(pAggData) + 1
    If 0 = cAggElems Then Err.Raise E_INVALIDARG
    On Error Resume Next
    cIIDs = UBound(pIIDs) - LBound(pIIDs) + 1
    On Error GoTo 0

    'Get a count of all data so that we can initialize
    'with a single allocation.
    PreAllocData_Initialize PAD, pAggData, cAggElems, cIIDs
    
    With m_DerefUnkHookAggregate
        pAlloc = CoTaskMemAlloc(LenB(.pSA(0)) + PAD.cExtraBytes)
        If pAlloc = 0 Then Err.Raise E_OUTOFMEMORY
        ZeroMemory ByVal pAlloc, LenB(.pSA(0)) + PAD.cExtraBytes
        PAD.pExtraBytes = PrivVBoost.UAdd(pAlloc, LenB(.pSA(0)))
        .Owner.SA.pvData = pAlloc
        With .pSA(0)
            .pVTable = m_pUnkHookAggregateVTable
            .pQIHookVTable = m_pUnkHookAggregateIQIHookVTable
            .cRefs = 1
            ppOwner = VarPtr(.pVTable)
            
            PrivVBoost.AssignSwap pUnkUR, pUnk
            CAggregator_Initialize .Aggregator, pAggData, cAggElems, pIIDs, PAD, pUnkUR
            PrivVBoost.AssignAddRef pQIARHook, VarPtr(.pQIHookVTable)
            QIARHookStruct_Hook .Hook, pUnkUR, pQIARHook, CAggregator_GetFlags(.Aggregator), True, False, VarPtr(.pVTable)
        End With
    End With
    Exit Function
Error:
    AggregateUnknown = MapError
End Function
Private Function CUnkHookAggregate_QueryInterface(This As CUnkHookAggregate, riid As IID, pvObj As Long) As Long
Dim fOK As BOOL
    Select Case riid.Data1
        Case Data1_IID_UnknownHook
            fOK = IsEqualIID(riid, IID_UnknownHook)
        Case Data1_IID_IUnknown
            fOK = IsEqualIID(riid, IID_IUnknown)
    End Select
    If fOK Then
        With This
            pvObj = VarPtr(.pVTable)
            .cRefs = .cRefs + 1
        End With
    Else
        pvObj = 0
        CUnkHookAggregate_QueryInterface = E_NOINTERFACE
    End If
End Function
Private Function CUnkHookAggregate_IQIHook_QueryInterface(This As CUnkHookAggregateIQIHook, riid As IID, pvObj As Long) As Long
    'This is never actually called by our implementation, but
    'may be called for ISupportErrorInfo, which we refuse.
    pvObj = 0
    CUnkHookAggregate_IQIHook_QueryInterface = E_NOINTERFACE
End Function
Private Function CUnkHookAggregate_AddRef(This As CUnkHookAggregate) As Long
    With This
        .cRefs = .cRefs + 1
        CUnkHookAggregate_AddRef = .cRefs
    End With
End Function
Private Function CUnkHookAggregate_IQIHook_AddRef(This As CUnkHookAggregateIQIHook) As Long
    With This
        .cRefs = .cRefs + 1
        CUnkHookAggregate_IQIHook_AddRef = .cRefs
    End With
End Function
Private Function CUnkHookAggregate_Release(This As CUnkHookAggregate) As Long
    With This
        .cRefs = .cRefs - 1
        CUnkHookAggregate_Release = .cRefs
        If .cRefs = 0 Then
            'Tear down the hook before the aggregator (or crash)
            CAggregator_Terminate .Aggregator
            QIARHookStruct_Unhook .Hook
            CoTaskMemFree VarPtr(This)
        End If
    End With
End Function
Private Function CUnkHookAggregate_IQIHook_Release(This As CUnkHookAggregateIQIHook) As Long
    With This
        .cRefs = .cRefs - 1
        CUnkHookAggregate_IQIHook_Release = .cRefs
        If .cRefs = 0 Then
            'Tear down the hook before the aggregator (or crash)
            CAggregator_Terminate .Aggregator
            QIARHookStruct_Unhook .Hook
            CoTaskMemFree PrivVBoost.UDif(VarPtr(This), 4)
        End If
    End With
End Function
Private Function CUnkHookAggregate_IQIHook_QIHook(This As CUnkHookAggregateIQIHook, riid As IID, ByVal uhFlags As UnkHookFlags, ppResult As IUnknown, ByVal HookedUnknown As IUnknown) As Long
Dim pNodeToWrap As Long
Dim pOldResult As IUnknown
    If Not ppResult Is Nothing Then Exit Function
    If riid.Data1 = Data1_IID_IUnknown Then
        If IsEqualIID(riid, IID_IUnknown) Then Exit Function
    End If
    
    CAggregator_DoQIHook This.Aggregator, riid, pNodeToWrap, CBool(uhFlags And uhAfterQI), ppResult
    
    If pNodeToWrap Then
        If Not ppResult Is Nothing Then
            PrivVBoost.AssignSwap pOldResult, ppResult
            On Error Resume Next
            Set ppResult = PrivVBoost.CreateDelegator(This.Hook.pOuter, pOldResult, 0, pNodeToWrap, 0)
            On Error GoTo 0
            Set pOldResult = Nothing
        End If
    End If
End Function
Private Function CUnkHookAggregate_IQIHook_MapIID(This As CUnkHookAggregateIQIHook, pIID As IID) As Long
    CUnkHookAggregate_IQIHook_MapIID = CAggregator_DoMapIID(This.Aggregator, pIID)
End Function
Private Function CUnkHookAggregate_get_Flags(This As CUnkHookAggregate, puhFlags As UnkHookFlags) As Long
    puhFlags = CAggregator_GetFlags(This.Aggregator)
End Function
Private Function CUnkHookAggregate_put_Flags(This As CUnkHookAggregate, ByVal puhFlags As UnkHookFlags) As Long
    CUnkHookAggregate_put_Flags = &H800A017F 'CTL_E_NOTSUPPORTED
End Function
#End If 'DO_AGGUNK

#If DO_AGGCREATE Then
'CAggregateObject implementation
Private Function CreateAggregate(This As RootStruct, pAggData() As VBoostTypes.AggregateData, pIIDs() As VBoostTypes.VBGUID, ByVal ppOwner As Long, ppvObj As VBoostTypes.IUnknownUnrestricted) As Long
Dim cAggElems As Long
Dim cIIDs As Long
Dim PAD As PreAllocData
Dim pAlloc As Long
    On Error GoTo Error
    PrivVBoost.AssignZero ppvObj
    If Not m_fAggregatorsInit Then InitAggregators
    cAggElems = UBound(pAggData) - LBound(pAggData) + 1
    If 0 = cAggElems Then Err.Raise E_INVALIDARG
    On Error Resume Next
    cIIDs = UBound(pIIDs) - LBound(pIIDs) + 1
    On Error GoTo 0
    
    'Get a count of all data so that we can initialize
    'with a single allocation.
    PreAllocData_Initialize PAD, pAggData, cAggElems, cIIDs
    
    With m_DerefAggregateObject
        pAlloc = CoTaskMemAlloc(LenB(.pSA(0)) + PAD.cExtraBytes)
        If pAlloc = 0 Then Err.Raise E_OUTOFMEMORY
        ZeroMemory ByVal pAlloc, LenB(.pSA(0)) + PAD.cExtraBytes
        PAD.pExtraBytes = PrivVBoost.UAdd(pAlloc, LenB(.pSA(0)))
        .Owner.SA.pvData = pAlloc
        With .pSA(0)
            .pVTable = m_pAggregateObjectVTable
            .cRefs = 1
            PrivVBoost.Assign ppvObj, VarPtr(.pVTable)
            'This may error out, but we're prepared now to handle it
            CAggregator_Initialize .Aggregator, pAggData, cAggElems, pIIDs, PAD, ppvObj
            .uhFlags = CAggregator_GetFlags(.Aggregator)
            If ppOwner Then
                PrivVBoost.Assign ByVal ppOwner, pAlloc
                .ppThis = ppOwner
            End If
        End With
    End With
    Exit Function
Error:
    CreateAggregate = MapError
End Function
Private Function CAggregateObject_QueryInterface(This As CAggregateObject, riid As IID, pvObj As Long) As Long
Dim pResult As IUnknown
Dim pNodeToWrap As Long 'IIDHookNode*
Dim iidUse As IID
Dim pUnkThis As IUnknown
    If riid.Data1 = 0 Then
        If IsEqualIID(riid, IID_IUnknown) Then
            pvObj = VarPtr(This)
            This.cRefs = This.cRefs + 1
            Exit Function
        End If
    End If
    pvObj = 0
    iidUse = riid 'We don't always need the copy, but the code is easier and smaller
    With This
        If .uhFlags And uhMapIIDs Then
            CAggregateObject_QueryInterface = CAggregator_DoMapIID(.Aggregator, iidUse)
            If CAggregateObject_QueryInterface Then Exit Function
        End If
        If .uhFlags And uhBeforeQI Then
            CAggregateObject_QueryInterface = CAggregator_DoQIHook(.Aggregator, iidUse, pNodeToWrap, False, pResult)
            If CAggregateObject_QueryInterface Then Exit Function
        End If
        If pResult Is Nothing Then
            If .uhFlags And uhAfterQI Then
                CAggregateObject_QueryInterface = CAggregator_DoQIHook(.Aggregator, iidUse, pNodeToWrap, True, pResult)
                If CAggregateObject_QueryInterface Then Exit Function
            End If
        End If
        If pNodeToWrap Then
            If Not pResult Is Nothing Then
                'Do this in place of AssignAddRef
                PrivVBoost.Assign pUnkThis, VarPtr(.pVTable)
                .cRefs = .cRefs + 1
                
                On Error Resume Next
                Set pResult = PrivVBoost.CreateDelegator(pUnkThis, pResult, 0, pNodeToWrap, 0)
                CAggregateObject_QueryInterface = Err
                On Error GoTo 0
                If CAggregateObject_QueryInterface Then
                    Set pResult = Nothing
                    Exit Function
                End If
            End If
        End If
    End With
    PrivVBoost.AssignSwap pvObj, pResult
    If pvObj = 0 Then CAggregateObject_QueryInterface = E_NOINTERFACE
End Function
Private Function CAggregateObject_AddRef(This As CAggregateObject) As Long
    With This
        .cRefs = .cRefs + 1
        CAggregateObject_AddRef = .cRefs
    End With
End Function
Private Function CAggregateObject_Release(This As CAggregateObject) As Long
    With This
        .cRefs = .cRefs - 1
        CAggregateObject_Release = .cRefs
        If .cRefs = 0 Then
            If .ppThis Then PrivVBoost.AssignZero ByVal .ppThis
            CAggregator_Terminate This.Aggregator
            CoTaskMemFree VarPtr(.pVTable)
        End If
    End With
End Function
#End If 'DO_AGGCREATE

Private Function FuncAddr(ByVal pfn As Long) As Long
    FuncAddr = pfn
End Function
#End If 'VBOOST_INTERNAL
#End If 'NOVBOOST = 0
'Assign
'//*(long*)pDst = *(long*)pSrc;
'mov         eax,dword ptr [esp+0Ch]
'mov         edx,dword ptr [esp+8]
'mov         ecx,dword ptr [eax]
'mov         dword ptr [edx],ecx
'ret         0Ch
'nop

'Deref
'//return *(long*)Ptr;
'mov         eax,dword ptr [esp+8]
'mov         eax,dword ptr [eax]
'ret         8
'nop
'nop
'nop

'UAdd
'//return (long)((ULONG)x + (ULONG)y);
'mov         eax,dword ptr [esp+0Ch]
'mov         ecx,dword ptr [esp+8]
'add         eax,ecx
'ret         0Ch
'nop
'nop
'nop

'UDif
'//return (long)((ULONG)x - (ULONG)y);
'mov         eax,dword ptr [esp+8]
'mov         ecx,dword ptr [esp+0Ch]
'sub         eax,ecx
'ret         0Ch
'nop
'nop
'nop

'UGT
'//return ((ULONG)x > (ULONG)y) ? VARIANT_TRUE : VARIANT_FALSE;
'mov         eax,dword ptr [esp+0Ch]
'mov         ecx,dword ptr [esp+8]
'cmp         eax,ecx
'sbb         eax,eax
'ret         0Ch
'nop

'UGTE
'//return ((ULONG)x >= (ULONG)y) ? VARIANT_TRUE : VARIANT_FALSE;
'mov         eax,dword ptr [esp+8]
'mov         ecx,dword ptr [esp+0Ch]
'cmp         eax,ecx
'sbb         eax,eax
'neg         eax
'dec         eax
'ret         0Ch
'nop
'nop

'AssignZero
'//*(void**)pDst = NULL;
'mov         ecx, dword ptr [esp + 8]
'xor         eax, eax
'mov         dword ptr [ecx], eax
'ret         8

'AssignSwap
'// Custom _asm block
'mov         eax,dword ptr [esp+8]
'mov         edx,dword ptr [esp+0Ch]
'mov         ecx,dword ptr [eax]
'xchg        ecx,dword ptr [edx]
'mov         dword ptr [eax],ecx
'ret         0Ch
'nop
'nop
'nop

'MoveVariant
'//varDst->decVal = varSrc->decVal;
'//varSrc->vt = VT_EMPTY;
'mov         eax,dword ptr [esp+0Ch]
'mov         edx,dword ptr [esp+8]
'mov         ecx,eax
'push        esi
'mov         esi,dword ptr [ecx]
'mov         dword ptr [edx],esi
'mov         esi,dword ptr [ecx+4]
'mov         dword ptr [edx+4],esi
'mov         esi,dword ptr [ecx+8]
'mov         dword ptr [edx+8],esi
'pop         esi
'mov         ecx,dword ptr [ecx+0Ch]
'mov         dword ptr [edx+0Ch],ecx
'mov         word ptr [eax],0
'ret         0Ch
'nop
'nop

'UDiv
'return (long)((ULONG)x / (ULONG)y);
'mov         eax,dword ptr [esp+8]
'xor         edx,edx
'div         eax,dword ptr [esp+0Ch]
'ret         0Ch
'nop
'nop
'nop

